(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) (FILECREATED " 9-Oct-2026 13:19:07" {MEDLEY}tedit>TEDIT-TFBRAVO.;217 102277 :EDIT-BY rmk :CHANGES-TO (FNS \TFBRAVO.READ.PARALOOKS) :PREVIOUS-DATE " 2-Aug-2026 21:25:51" {MEDLEY}tedit>TEDIT-TFBRAVO.;216) (PRETTYCOMPRINT TEDIT-TFBRAVOCOMS) (RPAQQ TEDIT-TFBRAVOCOMS [[DECLARE%: EVAL@COMPILE DONTCOPY (* ; "Compile-time needs") (FILES TEDIT-EXPORTS.ALL) (RECORDS BRAVOFONT PARA RUN) (MACROS GETBPROP SETBPROP) (MACROS \TFBRAVO.GETFONT \TOPOINTS) (CONSTANTS (BRAVO.TRAILER.CHARS '(l d z x e y k j c q %( %) %, s S u U b B i I g G v V w W t f o % \ 0 1 2 3 4 5 6 7 8 9] (* ;; "Interface to TEDIT and CONVERT.TO.IMAGE.FILE") (FNS BRAVOFILEP TEDITFROMBRAVO) (ADDVARS (TEDIT.INPUT.FORMATS (BRAVOFILEP TEDITFROMBRAVO))) (ALISTS (PRINTFILETYPES BRAVO)) [P (DEFAULT.IMAGETYPE.CONVERSIONS '(BRAVO TEDIT.TO.IMAGEFILE] (* ;; "Initial looks, USER.CM") (FNS \TFBRAVO.GET.USER.CM \TFBRAVO.USER.CM.LOOKS \TFBRAVO.READ.USER.CM \TFBRAVO.INIT.PARALOOKS \TFBRAVO.INIT.PAGEFORMAT \TFBRAVO.GETPARAMS \TFBRAVO.FIND.LAST.TRAILER) (* ;; "Decoding the Bravo file") (FNS \TFBRAVO.PARSE.PARA \TFBRAVO.READ.PARALOOKS \TFBRAVO.CREATE.RUNS \TFBRAVO.READ.CHARLOOKS \TFBRAVO.FONT.FROM.CHARLOOKS \TFBRAVO.READNUM?) (* ;; "Profile paragraphs") (FNS \TFBRAVO.HANDLE.HEADING \TFBRAVO.PARSE.PROFILE.PARA) (* ;; "Creating the text stream") (FNS \TFBRAVO.INSERT.PARA \TFBRAVO.INSERT.RUN \TFBRAVO.RUN.TABSPEC \TFBRAVO.INSTALL.PAGEFORMAT) (FNS \TFBRAVO.ASSERT \TEST.CHARACTER.LOOKS \TEST.PARAGRAPH.LOOKS) (INITVARS [TEDIT.DEFAULT.USER.CM '((ParagraphLeading 12) (LineLeading 6) (FirstLineLeftMargin 84) (LeftMargin 84) (RightMargin 528) (DefaultTab 36) (Font (0 TIMESROMAN 10 NIL NIL) (1 TIMESROMAN 8 NIL NIL) (2 HIPPO 8 NIL NIL) (3 GACHA 8 NIL NIL) (4 MATH 8 NIL NIL) (5 HELVETICA 12 NIL NIL) (6 GACHA 6 NIL NIL) (7 TIMESROMAN 9 NIL NIL) (8 HELVETICA 10 NIL NIL) (9 HELVETICA 11 NIL NIL] (USER.CM.RDTBL (COPYREADTABLE)) (PROFILE.PARA.RDTBL (COPYREADTABLE))) (P (SETBRK (CHARCODE (%, %: = CR)) NIL USER.CM.RDTBL) (SETSEPR '(% ) NIL USER.CM.RDTBL) (SETSYNTAX (CHARCODE %:) 'SEPRCHAR PROFILE.PARA.RDTBL) (SETSYNTAX (CHARCODE CR) 'BREAKCHAR PROFILE.PARA.RDTBL) (SETSYNTAX (CHARCODE ^Z) 'BREAKCHAR PROFILE.PARA.RDTBL)) (COMS (* ; "Named tabs. ") (FNS TEDIT.TABOBJ \TFBRAVO.ADD.NAMEDTAB \TEDIT.NAMEDTAB.DISPLAY \TEDIT.NAMEDTAB.BUTTONEVENT \TEDIT.NAMEDTAB.COPY \TEDIT.NAMEDTAB.PUT \TEDIT.NAMEDTAB.GET \TEDIT.NAMEDTAB.IMAGEBOX \TEDIT.NAMEDTAB.PREPRINT \TEDIT.NAMEDTAB.INIT) (GLOBALVARS \TEDIT.NAMEDTAB.IMAGEFNS) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEDIT.NAMEDTAB.INIT]) (DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD TEDIT-EXPORTS.ALL) (DECLARE%: EVAL@COMPILE (RECORD BRAVOFONT (BRFAMILY BRSIZE BRWEIGHT BRSLOPE)) (RECORD PARA (PARAPLOOKS RUNS)) (RECORD RUN (RUNLENGTH RUNLOOKS RUNSTART RUNLAST RUNFORMATPTRS RUNTABS)) ) (DECLARE%: EVAL@COMPILE (PUTPROPS GETBPROP MACRO ((TEXTOBJ PROP) (GETMULTI (FGETTOBJ TEXTOBJ EDITPROPS) 'BRAVOPROPS PROP))) (PUTPROPS SETBPROP MACRO ((TEXTOB PROP VALUE) (PUTMULTI (FGETTOBJ TEXTOBJ EDITPROPS) 'BRAVOPROPS PROP VALUE))) ) (DECLARE%: EVAL@COMPILE (PUTPROPS \TFBRAVO.GETFONT MACRO ((FONTNUM FIELD) (fetch (BRAVOFONT FIELD) of (GETMULTI (GETBPROP TEXTOBJ 'USER.CM.ALIST) 'Font FONTNUM)))) (PUTPROPS \TOPOINTS MACRO ((DIMENSION) (* ;; "Assumes that the next token in LINE is a number to be converted to points, according to the conventions specified in the Bravo user manual. Negative distances are relative to an 8.5 x 11 US Letter page. ") (* ;; "This positions LINE at the token after the unit, if any.") (LET ((NUM (pop LINE)) (UNIT (CAR LINE))) [SETQ UNIT (SELECTQ (U-CASE UNIT) ((IN INCH INCHES %") (pop LINE) 'INCH) ((CM CMS) (pop LINE) 'CM) ((POINT POINTS PT PTS) (pop LINE) 'POINT) (CL:IF (FLOATP NUM) 'INCH 'POINT)] (SETQ NUM (SELECTQ UNIT (INCH (FIXR (TIMES NUM 72))) (CM (FIXR (FQUOTIENT (TIMES NUM 2.54 72)))) NUM)) (CL:WHEN (ILESSP NUM 0) (SETQ NUM (SELECTQ DIMENSION (HEIGHT (IPLUS (CONSTANT (ITIMES 11 72)) NUM)) (WIDTH (IPLUS (CONSTANT (FIX (FTIMES 8.5 72))) NUM)) (NIL NUM) (\TEDIT.THELP "UNKNOWN DIMENSION" DIMENSION)))) NUM))) ) (DECLARE%: EVAL@COMPILE (RPAQQ BRAVO.TRAILER.CHARS (l d z x e y k j c q %( %) %, s S u U b B i I g G v V w W t f o % \ 0 1 2 3 4 5 6 7 8 9)) [CONSTANTS (BRAVO.TRAILER.CHARS '(l d z x e y k j c q %( %) %, s S u U b B i I g G v V w W t f o % \ 0 1 2 3 4 5 6 7 8 9] ) ) (* ;; "Interface to TEDIT and CONVERT.TO.IMAGE.FILE") (DEFINEQ (BRAVOFILEP [LAMBDA (FILE TEXTOBJ) (* ; "Edited 21-Jan-2026 12:15 by rmk") (* ; "Edited 28-Nov-2023 10:34 by rmk") (* ; "Edited 17-Aug-2023 08:09 by rmk") (* ; "Edited 11-Aug-2023 22:59 by rmk") (* ; "Edited 5-Aug-2023 23:05 by rmk") (* ; "Edited 1-Aug-2023 08:15 by rmk") (* gbn " 3-Jun-85 21:06") (* ;; "T if FILE looks like a Bravo file.") (RESETLST (PROG* ((STREAM (\GETSTREAM FILE 'INPUT T)) (ORIGINAL.FILE.POSITION (CL:IF STREAM (GETFILEPTR STREAM) 0)) PLOOKS ENDCONDITION NAME DIRS USER.CM) (* ;  "first look for a ^z, (beginning of a Bravo trailer)") (CL:UNLESS STREAM [RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT)) `(PROGN (CLOSEF? OLDVALUE]) (CL:UNLESS (\TFBRAVO.FIND.LAST.TRAILER STREAM) (SETFILEPTR STREAM ORIGINAL.FILE.POSITION) (RETURN NIL)) (* ; "BIN past the ^z") (BIN STREAM) (SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS STREAM)) (* ;  "if the next symbol is a slash then check if the character looks are valid") [SETQ ENDCONDITION (CL:WHEN (EQ (CAR PLOOKS) '\) (repeatuntil (\TEST.CHARACTER.LOOKS STREAM)))] (SETFILEPTR STREAM ORIGINAL.FILE.POSITION) (CL:WHEN (EQ ENDCONDITION 'BADLOOKS) (RETURN NIL)) (RETURN T)))]) (TEDITFROMBRAVO [LAMBDA (BFILE TSTREAM PROPS USER.CM) (* ; "Edited 5-Jul-2026 00:40 by rmk") (* ; "Edited 3-Jul-2026 19:17 by rmk") (* ; "Edited 1-Jul-2026 19:49 by rmk") (* ; "Edited 14-Jun-2026 23:55 by rmk") (* ; "Edited 7-Sep-2025 11:09 by rmk") (* ; "Edited 9-May-2025 09:18 by rmk") (* ; "Edited 28-Mar-2025 14:16 by rmk") (* ; "Edited 19-Feb-2025 12:13 by rmk") (* ; "Edited 8-Feb-2025 23:03 by rmk") (* ; "Edited 2-Jan-2025 22:22 by rmk") (* ; "Edited 17-Jan-2024 12:11 by rmk") (* ; "Edited 26-Nov-2023 00:29 by rmk") (* ; "Edited 14-Nov-2023 17:09 by rmk") (* ; "Edited 22-Sep-2023 08:53 by rmk") (* ; "Edited 20-Aug-2023 20:25 by rmk") (* ; "Edited 18-Aug-2023 22:18 by rmk") (* ; "Edited 17-Aug-2023 10:17 by rmk") (* ; "Edited 13-Jun-90 01:00 by mitani") (* ;;; "Top level entry for conversion from a Bravo file to a textstream. The textstream is returned, %"Writing%" here means sticking it in the textstream, not saving to a Tedit file. Assumes that a stream BFILE is positioned at the first byte to be included.") (RESETLST (CL:UNLESS TSTREAM (SETQ TSTREAM (OPENTEXTSTREAM NIL))) (* ;  " Produce the USER.CM's alist of default values") (bind PARA NEXTPARALOOKS START NAMEDTABS (BSTREAM _ BFILE) (TEXTOBJ _ (TEXTOBJ TSTREAM)) declare (SPECVARS NAMEDTABS) first (CL:UNLESS (SETQ USER.CM (\TFBRAVO.GET.USER.CM BFILE USER.CM TEXTOBJ PROPS)) (* ; "Go for plain text") (RETURN)) (SETTOBJ TEXTOBJ FORMATTEDP T) (\TFBRAVO.USER.CM.LOOKS USER.CM TEXTOBJ) (* ; "Set up the USER.CM look defaults") (CL:UNLESS (GETSTREAM BSTREAM 'INPUT T) (* ;  "We keep it open, since we point to it") (SETQ BSTREAM (OPENSTREAM BFILE 'INPUT))) (STREAMPROP BSTREAM :EXTERNAL-FORMAT :THROUGH) (PUTTEXTPROP TEXTOBJ 'OUTPUT-FORMAT :DEFAULT) [RESETSAVE (STREAMPROP BSTREAM 'ENDOFSTREAMOP (FUNCTION NILL)) `(PROGN (STREAMPROP ,BSTREAM 'ENDOFSTREAMOP OLDVALUE] (SETQ NEXTPARALOOKS (GETBPROP TEXTOBJ 'USER.CM.PARALOOKS)) eachtime (SETQ START (GETFILEPTR BSTREAM)) (* ;  "Profiles and headings have to back up") (SETQ PARA (\TFBRAVO.PARSE.PARA NEXTPARALOOKS BSTREAM TEXTOBJ)) (* ;; "No runs signals the very end") while (fetch (PARA RUNS) of PARA) do (SETQ NEXTPARALOOKS (fetch (PARA PARAPLOOKS) of PARA)) (* ;; "Valid profile paragraphs have a special interpretation, invalid ones must be mismarked ordinary text") (CL:UNLESS (AND (EQ 'PROFILE (GETPLOOKS NEXTPARALOOKS FMTPARATYPE)) (\TFBRAVO.PARSE.PROFILE.PARA BSTREAM PARA TSTREAM START)) (\TFBRAVO.INSERT.PARA PARA BSTREAM TSTREAM)) finally (\TFBRAVO.INSTALL.PAGEFORMAT TSTREAM) (\TEDIT.UNIQUIFY.ALL TEXTOBJ) (* ; "Lists are complete and unique") (\TEDIT.MCCS.TRANSLATE TSTREAM) (TEDIT.SETSEL TEXTOBJ 1 0 'LEFT) (RETURN TSTREAM)))]) ) (ADDTOVAR TEDIT.INPUT.FORMATS (BRAVOFILEP TEDITFROMBRAVO)) (ADDTOVAR PRINTFILETYPES (BRAVO (TEST BRAVOFILEP) (EXTENSION (BRAVO)))) (DEFAULT.IMAGETYPE.CONVERSIONS '(BRAVO TEDIT.TO.IMAGEFILE)) (* ;; "Initial looks, USER.CM") (DEFINEQ (\TFBRAVO.GET.USER.CM [LAMBDA (BFILE CANDIDATE TEXTOBJ PROPS) (* ; "Edited 4-Jul-2026 17:31 by rmk") (* ; "Edited 10-May-2025 12:53 by rmk") (* ; "Edited 28-Nov-2023 17:38 by rmk") (* ; "Edited 11-Sep-2023 13:15 by rmk") (* ; "Edited 19-Aug-2023 23:24 by rmk") (* ; "Edited 17-Aug-2023 09:46 by rmk") (* ;; "Returns the name of the user.cm file to be used in the conversion of Bravo BFILE. If CANDIDATE can't be found, the heuristic search is to search in the following order: ") (* ;; " BFILE's directory, connected directory, logindirectory, DIRECTORIES") (DECLARE (USEDFREE TEDIT-DEFAULT-USER.CM)) (CL:WHEN (STREAMP BFILE) (SETQ BFILE (FULLNAME BFILE))) (CL:WHEN (EQ CANDIDATE T) (* ;  "Because the test function's non-NIL value is passed in as CANDIDATE.") (SETQ CANDIDATE NIL)) (CL:UNLESS CANDIDATE (SETQ CANDIDATE 'USER.CM)) (OR (STREAMP CANDIDATE) (PROG [USER.CM (PROP (LISTGET PROPS 'USER.CM)) (DIRS `(,(PACKFILENAME 'NAME NIL 'EXTENSION NIL 'VERSION NIL 'BODY BFILE) T NIL ,@DIRECTORIES] (* ;;  "If we find CANDIDATE in the same directory, just notify without asking for confirmation") (CL:WHEN (SETQ USER.CM (INFILEP (PACKFILENAME 'BODY CANDIDATE 'BODY BFILE))) (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "USER.CM = " USER.CM) T) (RETURN USER.CM)) (* ;; "Search more broadly for PROP before asking--comes after CANDIDATE because it could be an HCFILES default. BFILE's directory has priority") (CL:WHEN [AND PROP (SETQ USER.CM (OR (LISTP PROP) (FINDFILE PROP T DIRS] (RETURN USER.CM)) (* ;; "Search and confirm") (FLASHWINDOW PROMPTWINDOW) (CL:WHEN (SETQ USER.CM (FINDFILE CANDIDATE T DIRS)) (SELECTQ [MKATOM (U-CASE (TEDIT.GETINPUT TEXTOBJ (CONCAT "USER.CM = " USER.CM " ? " ] ((Y YES) (RETURN USER.CM)) (NIL (* ; "CR response") (TEDIT.PROMPTPRINT TEXTOBJ "Yes") (RETURN USER.CM)) NIL)) (* ;; "Ask for a file name") (CL:WHEN (SETQ USER.CM (FINDFILE (TEDIT.GETINPUT TEXTOBJ "Please enter the USER.CM file (CR for TEDIT default): " "TEDIT.DEFAULT.USER.CM") T DIRS)) (RETURN USER.CM)) (RETURN TEDIT.DEFAULT.USER.CM]) (\TFBRAVO.USER.CM.LOOKS [LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 14-Jun-2026 17:07 by rmk") (* ; "Edited 10-May-2025 08:10 by rmk") (* ; "Edited 8-Feb-2025 22:13 by rmk") (* ; "Edited 2-Jan-2025 11:06 by rmk") (* ; "Edited 18-Aug-2023 18:47 by rmk") (* ; "Edited 16-Aug-2023 21:33 by rmk") (* ; "Edited 5-Aug-2023 17:15 by rmk") (SETBPROP TEXTOBJ 'USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM)) (\TFBRAVO.INIT.PAGEFORMAT TEXTOBJ) (SETBPROP TEXTOBJ 'USER.CM.PARALOOKS (\TFBRAVO.INIT.PARALOOKS TEXTOBJ)) (SETBPROP TEXTOBJ 'USER.CM.CHARLOOKS (\TFBRAVO.FONT.FROM.CHARLOOKS TEXTOBJ (create CHARLOOKS CLOFFSET _ 0) (\TFBRAVO.GETFONT 0 BRFAMILY) (\TFBRAVO.GETFONT 0 BRSIZE))) (SETTOBJ TEXTOBJ DEFAULTCHARLOOKS (GETBPROP TEXTOBJ 'USER.CM.CHARLOOKS)) (SETTOBJ TEXTOBJ DEFAULTPARALOOKS (GETBPROP TEXTOBJ 'USER.CM.PARALOOKS]) (\TFBRAVO.READ.USER.CM [LAMBDA (USER.CM) (* ; "Edited 14-Jun-2026 22:42 by rmk") (* ; "Edited 9-May-2025 00:54 by rmk") (* ; "Edited 27-Aug-2024 18:12 by rmk") (* ; "Edited 18-Aug-2023 22:26 by rmk") (* ; "Edited 10-Aug-2023 13:02 by rmk") (* ; "Edited 7-Aug-2023 12:52 by rmk") (* ; "Edited 1-Aug-2023 22:11 by rmk") (* ; "Edited 30-Jul-2023 18:57 by rmk") (* gbn "17-Sep-84 18:53") (* ;; "digests a user.cm file returning an alist of contents. Returns ((Font)) if no bravo section of user.cm file") (OR (LISTP USER.CM) (RESETLST (PROG (ALIST LINE) (CL:UNLESS (GETSTREAM USER.CM 'INPUT T) [RESETSAVE (SETQ USER.CM (OPENSTREAM USER.CM 'INPUT 'OLD)) `(PROGN (CLOSEF? OLDVALUE]) (SETFILEINFO USER.CM 'EOL 'ANY) (AND NIL (STREAMPROP USER.CM :EXTERNAL-FORMAT :THROUGH)) (CL:UNLESS (AND (FILEPOS "[BRAVO]" USER.CM NIL NIL NIL T) (EQ (CHARCODE EOL) (READCCODE USER.CM))) (RETURN NIL)) (* ;; "Read lines of the user.cm file until getting the empty line caused by eof (and the errortypelst entry) or until a line starts with '[' .") LLP (CL:UNLESS (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL))) USER.CM USER.CM.RDTBL))) (CL:UNLESS (ASSOC 'DefaultTab ALIST) (push ALIST (CONS 'DefaulTab DEFAULTTAB))) (RETURN ALIST)) (* ;  "If the '[BRAVO]' section is the last one") (COND ((NULL LINE) (* ; "ignore blank lines") (GO LLP)) ((EQ (CAR LINE) 'END.OF.FILE) (RETURN ALIST)) ((EQ (NTHCHAR (CAR LINE) 1) '%[) (* ;; "if '[' is the first character of the line, return the alist so far, because this is the beginning of the next section of the user.cm") (RETURN ALIST)) ((NEQ (CADR LINE) '%:) (GO LLP))) (* ;; "CDDR to skip the :") (SELECTQ (PROG1 (CAR LINE) (SETQ LINE (CDDR LINE))) (FONT (CL:WHEN (FIXP (CAR LINE)) (PUTMULTI ALIST 'Font (POP LINE) (create BRAVOFONT BRFAMILY _ (POP LINE) BRSIZE _ (POP LINE))))) (TABS (SETQ ALIST (NCONC (\TFBRAVO.GETPARAMS LINE '((DefaultTab standard tab width)) 'MICATOPOINTS) ALIST))) (MARGINS (SETQ ALIST (NCONC (\TFBRAVO.GETPARAMS LINE '((FirstLineLeftMargin paragraph margin) (LeftMargin left margin) (RightMargin right margin)) 'MICATOHALFPICAPOINTS) ALIST))) (LEAD (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE '((ParagraphLeading paragraph leading) (LineLeading line leading] ALIST))) NIL) (GO LLP)))]) (\TFBRAVO.INIT.PARALOOKS [LAMBDA (TEXTOBJ) (* ; "Edited 14-Jun-2026 22:40 by rmk") (* ; "Edited 28-Jul-2025 23:12 by rmk") (* ; "Edited 8-Feb-2025 22:09 by rmk") (* ; "Edited 4-Aug-2024 22:17 by rmk") (* ; "Edited 28-Jul-2024 21:36 by rmk") (* ; "Edited 13-Aug-2023 11:27 by rmk") (* ; "Edited 8-Aug-2023 23:51 by rmk") (* ; "Edited 7-Aug-2023 14:59 by rmk") (* ; "Edited 31-May-91 15:26 by jds") (* ;; "creates the default paragraph looks from the USER.CM. The numeric values are Bravo defaults as specfied in the Bravo documentation. This assumes that all mica values in the USER.CM have already been converted to points. ") (LET ((INITPARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST TEDIT.DEFAULT.PARALOOKS))) (* ;; "Bravo User Manual says that default tab is 36, the Bravo file format document says 60. I'm going with 36.") (with PARALOOKS INITPARALOOKS (SETQ LEFTMAR (OR (GETMULTI TEXTOBJ 'USER.CM.ALIST 'LeftMargin) 85)) (SETQ 1STLEFTMAR (OR (GETMULTI TEXTOBJ 'USER.CM.ALIST 'FirstLineLeftMargin) LEFTMAR)) (SETQ RIGHTMAR (OR (GETMULTI TEXTOBJ 'USER.CM.ALIST 'RightMargin) 527)) (SETQ LINELEAD (OR (GETMULTI TEXTOBJ 'USER.CM.ALIST 'LineLeading) 1)) (SETQ LEADBEFORE (OR (GETMULTI TEXTOBJ 'USER.CM.ALIST 'ParagraphLeading) 0)) (SETQ LEADAFTER 0) (SETQ FMTDEFAULTTAB (OR (GETMULTI TEXTOBJ 'USER.CM.ALIST 'DefaultTab) DEFAULTTAB)) (SETQ FMTSPECIALX 0) (SETQ FMTSPECIALY 0)) (\TEDIT.UNIQUIFY.PARALOOKS INITPARALOOKS TEXTOBJ]) (\TFBRAVO.INIT.PAGEFORMAT [LAMBDA (TEXTOBJ) (* ; "Edited 14-Jun-2026 11:43 by rmk") (* ; "Edited 22-Sep-2023 20:03 by rmk") (* ; "Edited 10-Aug-2023 10:02 by rmk") (* gbn "31-May-85 17:13") (* ;;  "Page numbers centered and 1/2 inch from top of US Letter page. One inch top/bottom margins") (SETBPROP TEXTOBJ 'PAGENUMBERS T) (SETBPROP TEXTOBJ 'PAGENUMBERX (FIXR (FQUOTIENT (TIMES 8.5 72) 2))) (SETBPROP TEXTOBJ 'PAGENUMBERY (IDIFFERENCE (ITIMES 11 72) 36)) (SETBPROP TEXTOBJ 'TOPMARGIN 72) (SETBPROP TEXTOBJ 'BOTTOMMARGIN 72) (SETBPROP TEXTOBJ 'PAGENUMBER.NOTONFIRSTPAGE T]) (\TFBRAVO.GETPARAMS [LAMBDA (LINE NAMES SCALE) (* ; "Edited 10-Aug-2023 13:19 by rmk") (* ; "Edited 7-Aug-2023 12:34 by rmk") (* jds "27-Aug-84 09:37") (* ;; "If SCALE is provided, the values after = are numbers that will be scaled by SCALE.") (* ;; "LINE is a list of tokens for a particular line in the USER.CM. It may contain several parameters separated by commas, where each parameter is heading by a list of identifying names (CDR of the corresponding entry in NAMES) ending in =. (CAR N) for each N in NAMES is the tag that identifies that parameter in the resulting alist.") (LET (SEGMENTS VALUE ALIST) (* ;; "To simplify, first chop LINE into its comma-separated segments") (for LTAIL PREV (START _ LINE) on LINE do (if (NULL (CDR LTAIL)) then (push SEGMENTS START) (* ; "last one") elseif (EQ '%, (CAR LTAIL)) then (CL:WHEN PREV (* ; "Cut off the comma") (RPLACD PREV NIL)) (push SEGMENTS START) (SETQ START (CDR LTAIL)) (SETQ PREV START) else (SETQ PREV LTAIL))) (SETQ SEGMENTS (DREVERSE SEGMENTS)) (* ; "Now aligned with NAMES") [for N SEG in NAMES when [SETQ SEG (find S in SEGMENTS suchthat (for NTAIL on (CDR N) as SS in S always (OR (AND (EQ '= SS) (NULL (CDR NTAIL))) (STRING.EQUAL SS (CAR NTAIL] do (CL:WHEN (SETQ VALUE (CADR (MEMB '= SEG))) (PUSH ALIST (LIST (CAR N) (SELECTQ SCALE (MICATOPOINTS (FIXR (FQUOTIENT VALUE MICASPERPT))) (MICATOHALFPICAPOINTS [ITIMES 6 (FIXR (FQUOTIENT VALUE (FTIMES MICASPERPT 6]) VALUE))))] (DREVERSE ALIST]) (\TFBRAVO.FIND.LAST.TRAILER [LAMBDA (BSTREAM) (* ; "Edited 1-Aug-2023 23:35 by rmk") (* ; "Edited 8-Sep-2022 17:15 by rmk") (* jds "27-Dec-84 19:13") (* ;; "scans backwards from the end of the file trying to find the beginning of the last Bravo trailer. Returns NIL if not found, otherwise T") (LET [(STREAM (GETSTREAM BSTREAM 'INPUT] (SETFILEPTR STREAM -1) (CL:WHEN (AND (IGREATERP (GETFILEPTR STREAM) 0) (EQ (\BACKBIN STREAM) (CHARCODE CR))) (* ;  "empty files are not Bravo files. It says here!") (bind C while (AND (SETQ C (\BACKBIN STREAM)) (FMEMB (CHARACTER C) BRAVO.TRAILER.CHARS)) do NIL) (EQ (\PEEKBIN STREAM) (CHARCODE ^Z)))]) ) (* ;; "Decoding the Bravo file") (DEFINEQ (\TFBRAVO.PARSE.PARA [LAMBDA (OLDPARALOOKS BSTREAM TEXTOBJ) (* ; "Edited 7-Jul-2026 00:23 by rmk") (* ; "Edited 3-Jul-2026 23:02 by rmk") (* ; "Edited 14-Jun-2026 15:16 by rmk") (* ; "Edited 8-Feb-2025 23:04 by rmk") (* ; "Edited 21-Oct-2024 00:33 by rmk") (* ; "Edited 14-Nov-2023 13:03 by rmk") (* ; "Edited 7-Nov-2023 21:53 by rmk") (* ; "Edited 21-Aug-2023 23:41 by rmk") (* ; "Edited 20-Aug-2023 22:48 by rmk") (* ; "Edited 16-Aug-2023 21:28 by rmk") (* ; "Edited 13-Jun-2021 09:46 by rmk:") (* ;; "OLDPARALOOKS are the paragraph looks of the previous paragraph, and RUNi are the character runs in the form returned by \TFBRAVO.READ.CHARLOOKS, except that here we fill in the character count for the last run. Leaves the input file pointer at the end of the trailer, after the CR.") (* ;; "^Z marks the end of a Bravo-looks paragraph which may have internal CR's that maky surface as TEdit Meta,EOL. The Bravo runs with different charlooks want to end up in different pieces all within the same paragraph.") (* ;;  "The carriage return that ends the trailer is its own final run, the trailer itself is skipped.") (LET [BYTE PARALEN ^ZPTR ENDCHAR PARALOOKS RUNS FORMATPTRS (PARASTART (GETFILEPTR BSTREAM)) (PARALOOKS (GETBPROP TEXTOBJ 'USER.CM.PARALOOKS] (* ;; "BYTE=NIL at EOF, no terminating ^Z") (until (SELCHARQ (SETQ BYTE (BIN BSTREAM)) (^Z (* ;  "End of Bravo paragraph, maybe some looks") (SETQ ^ZPTR (SUB1 (GETFILEPTR BSTREAM))) (* ; "Exclude the ^Z") (SETQ PARALEN (IDIFFERENCE ^ZPTR PARASTART)) (* ;  "Length of the Bravo paragraph without the ^Z") [AND NIL (CL:WHEN FORMATPTRS (PUSH FORMATPTRS (CONS (CHARCODE ^Z) (SUB1 ^ZPTR))))] (SETQ FORMATPTRS (DREVERSE FORMATPTRS)) T) ((CR LF FORM TAB) (* ;; "Remember the position of line-breaking characters and tabs. Only ^z maps to a Tedit paragraph break, other CR, LF, CR/LF map to meta,EOL. FORM probably is a break, but probably also is preceded/followed by ^z. TAB may be interpreted as a namedtab image object.") (* ;; "FORMATPTRS here are file-relative") [PUSH FORMATPTRS (LIST (SELCHARQ BYTE ((CR LF) 'EOL) (FORM 'FORM) (TAB 'TAB) (SHOULDNT)) (SUB1 (GETFILEPTR BSTREAM] NIL) (NIL T) NIL)) (SELCHARQ BYTE (^Z (SETQ PARALOOKS (\TFBRAVO.READ.PARALOOKS OLDPARALOOKS BSTREAM TEXTOBJ)) (SETQ RUNS (\TFBRAVO.CREATE.RUNS BSTREAM PARASTART PARALEN TEXTOBJ FORMATPTRS)) (CL:UNLESS (EQ 0 (GETPLOOKS PARALOOKS FMTSPECIALY)) (* ;  "Bravo's vertical tabs specify the top of the line, Tedit's specify the baseline") [change (GETPLOOKS PARALOOKS FMTSPECIALY) (DIFFERENCE DATUM (FONTPROP (FGETCLOOKS (fetch (RUN RUNLOOKS) of (CAR RUNS)) CLFONT) 'ASCENT])) (NIL) (\TEDIT.THELP "Bravo paragraph not ending in ^Z, CR, EOF")) (create PARA PARAPLOOKS _ PARALOOKS RUNS _ RUNS]) (\TFBRAVO.READ.PARALOOKS [LAMBDA (OLDPARALOOKS BSTREAM TEXTOBJ) (* ; "Edited 9-Oct-2026 13:19 by rmk") (* ; "Edited 4-Jul-2026 23:58 by rmk") (* ; "Edited 3-Jul-2026 09:17 by rmk") (* ; "Edited 30-Jun-2026 10:02 by rmk") (* ; "Edited 14-Jun-2026 15:13 by rmk") (* ; "Edited 19-Feb-2025 12:14 by rmk") (* ; "Edited 8-Feb-2025 23:04 by rmk") (* ; "Edited 19-Dec-2024 23:42 by rmk") (* ; "Edited 21-Oct-2024 00:27 by rmk") (* ; "Edited 27-Aug-2024 21:59 by rmk") (* ; "Edited 28-Jul-2024 21:39 by rmk") (* ; "Edited 9-Sep-2023 21:40 by rmk") (* ; "Edited 21-Aug-2023 21:43 by rmk") (* ; "Edited 20-Aug-2023 15:48 by rmk") (* ; "Edited 18-Aug-2023 23:08 by rmk") (* ; "Edited 15-Aug-2023 00:23 by rmk") (* ; "Edited 13-Aug-2023 19:58 by rmk") (* ; "Edited 3-Aug-2023 00:20 by rmk") (* ; "Edited 31-May-91 15:26 by jds") (* ;;  "Decodes bravo paragraph looks into a TEDIT PARALOOKS. OLDPARALOOKS is used just for its tabs.") (DECLARE (USEDFREE NAMEDTABS)) (PARALOOKS! OLDPARALOOKS) (bind LMFLAG 1LMFLAG COMMAND TABX TABNAME MYTABS (TABDEFAULT _ (GETPLOOKS (GETBPROP TEXTOBJ ' USER.CM.PARALOOKS ) FMTDEFAULTTAB)) [NEWPARALOOKS _ (create PARALOOKS using (GETBPROP TEXTOBJ 'USER.CM.PARALOOKS] first (CL:UNLESS (EQ 'PROFILE (FGETPLOOKS OLDPARALOOKS FMTPARATYPE)) (* ;; "It appears that heading-tabs don't carry over to other paragraphs. Although maybe the default interval-tab does?") (SETQ TABDEFAULT (OR (FGETPLOOKS OLDPARALOOKS FMTDEFAULTTAB) (FGETPLOOKS (GETBPROP TEXTOBJ 'USER.CM.PARALOOKS) FMTDEFAULTTAB)))) do (SELCHARQ (SETQ COMMAND (BIN BSTREAM)) (l (SETQ LMFLAG T) (FSETPLOOKS NEWPARALOOKS LEFTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS))) (d (SETQ 1LMFLAG T) (FSETPLOOKS NEWPARALOOKS 1STLEFTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS))) (z (FSETPLOOKS NEWPARALOOKS RIGHTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS))) (x (FSETPLOOKS NEWPARALOOKS LINELEAD (\TFBRAVO.READNUM? BSTREAM T))) (e (FSETPLOOKS NEWPARALOOKS LEADAFTER 0) (FSETPLOOKS NEWPARALOOKS LEADBEFORE (\TFBRAVO.READNUM? BSTREAM T))) (y (* ; "vertical tabs are supported") (FSETPLOOKS NEWPARALOOKS FMTSPECIALX 0) (FSETPLOOKS NEWPARALOOKS FMTSPECIALY (\TFBRAVO.READNUM? BSTREAM T))) (k (FSETPLOOKS NEWPARALOOKS KEEPWITHNEXT (\TFBRAVO.READNUM? BSTREAM T))) (w 'HardcopyMode) (j (FSETPLOOKS NEWPARALOOKS QUAD 'JUSTIFIED)) (c (FSETPLOOKS NEWPARALOOKS QUAD 'CENTERED)) (q (* ;; "Profiles are marked here but then interpreted at the top") (FSETPLOOKS NEWPARALOOKS FMTPARATYPE 'PROFILE)) (%( (* ; "Collect the named tabs") (SETQ TABX (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Name or X position") (* ;; "Tabs apparently round down/truncate, not up.") (SELCHARQ (SETQ COMMAND (BIN BSTREAM)) (%) (SETQ TABDEFAULT (SCALEDOWN MICASPERPT TABX))) (%, (CL:WHEN (IGREATERP TABX 14) (\TEDIT.THELP TABX " is not a legal tab-name")) (SETQ TABNAME (ADD1 TABX)) (* ; "Adding 1 to align with t1, t2...") (SETQ TABX (\TFBRAVO.READNUM? BSTREAM T)) (CL:UNLESS (EQ (CHARCODE %)) (BIN BSTREAM)) (\TEDIT.THELP "MISSING CLOSING ) IN TABSPEC")) (* ;; "Here we collect the tabs declared in this paragraph or inherited from before. 65535 means delete that named tab (possibly inherited), otherwise the name is given a new TABX for all runs of this paragraph and beyond.") (PUTMULTI NAMEDTABS TABNAME (CL:UNLESS (EQ TABX 65535) (* ; "Flush NIL entries below") (SCALEDOWN MICASPERPT TABX)))) (\TEDIT.THELP "ILLFORMED BRAVO TAB SPEC"))) (SPACE) ((CR \) (CL:WHEN (AND LMFLAG (NOT 1LMFLAG)) (* ;  "If there was a Left margin but no firstline left then default it") (FSETPLOOKS NEWPARALOOKS 1STLEFTMAR (FGETPLOOKS NEWPARALOOKS LEFTMAR))) (FSETPLOOKS NEWPARALOOKS FMTDEFAULTTAB TABDEFAULT) (CL:WHEN (EQ COMMAND (CHARCODE CR)) (* ;  "Read the \ separator, but leave a terminating CR") (\BACKFILEPTR BSTREAM)) (* ;; "Set MYTABS above to reset NAMETABS to just the tabs defined here") (SETQ NAMEDTABS (SORT (for TAB in (OR MYTABS NAMEDTABS) when (CDR TAB) collect TAB) T)) (RETURN NEWPARALOOKS)) (\TEDIT.THELP (CHARACTER COMMAND) '" is not a legal Bravo paragraph-format character"]) (\TFBRAVO.CREATE.RUNS [LAMBDA (BSTREAM PARASTART PARALEN TEXTOBJ FORMATPTRS) (* ; "Edited 4-Jul-2026 14:34 by rmk") (* ; "Edited 1-Jul-2026 11:15 by rmk") (* ; "Edited 14-Jun-2026 15:21 by rmk") (* ; "Edited 14-Nov-2023 13:01 by rmk") (* ; "Edited 9-Sep-2023 21:41 by rmk") (* ; "Edited 20-Aug-2023 23:03 by rmk") (* ;; "A run is a sequence of characters within a paragraph that have the same charlooks") (bind RUNS RUN RLEN (RUNSTART _ PARASTART) (OLDCHARLOOKS _ (GETBPROP TEXTOBJ 'USER.CM.CHARLOOKS)) do (SETQ RUN (\TFBRAVO.READ.CHARLOOKS TEXTOBJ BSTREAM OLDCHARLOOKS RUNSTART PARALEN)) (* ;; "Assign FORMATPTRS to their runs") (for FPTAIL FPTR (ENDRUN _ (IPLUS RUNSTART (fetch (RUN RUNLENGTH) of RUN))) on FORMATPTRS eachtime (SETQ FPTR (CAR FPTAIL)) while (ILESSP (CADR FPTR) ENDRUN) collect (* ;; "Make pointers RUN-relative ") (change (CADR FPTR) (IDIFFERENCE DATUM RUNSTART)) FPTR finally (replace (RUN RUNFORMATPTRS) of RUN with $$VAL) (SETQ FORMATPTRS FPTAIL)) (push RUNS RUN) (SETQ OLDCHARLOOKS (fetch (RUN RUNLOOKS) of RUN)) (CL:WHEN (fetch (RUN RUNLAST) of RUN) (RETURN (DREVERSE RUNS))) (SETQ RLEN (fetch (RUN RUNLENGTH) of RUN)) (* ; "Set up for next run") (ADD RUNSTART RLEN) (ADD PARALEN (IMINUS RLEN)) (SETQ OLDCHARLOOKS (fetch (RUN RUNLOOKS) of RUN]) (\TFBRAVO.READ.CHARLOOKS [LAMBDA (TEXTOBJ BSTREAM OLDCHARLOOKS RUNSTART PARALEN) (* ; "Edited 5-Jul-2026 00:01 by rmk") (* ; "Edited 3-Jul-2026 00:38 by rmk") (* ; "Edited 14-Jun-2026 14:51 by rmk") (* ; "Edited 2-Jan-2025 23:44 by rmk") (* ; "Edited 21-Oct-2024 00:27 by rmk") (* ; "Edited 9-Sep-2023 21:39 by rmk") (* ; "Edited 20-Aug-2023 16:15 by rmk") (* ; "Edited 18-Aug-2023 20:11 by rmk") (* ; "Edited 31-May-91 15:25 by jds") (* ;; "Read the character looks trailer building a TEDIT charlooks record. Most fields are immediately valid, however, the tabcolor is stored in the cluserinfo field of the looks, and the font is still in numeric form") (* ;; "The charlooks trailer (from \ to CR) consists of a sequence of run-looks. Each run-look is a sequence of commands followed by the length of the run. If the first run has no commands (i.e. the \ is followed immediately by a length-number), than the first run gets the USER.CM default looks.") (bind COMMAND LAST VALUE TABPTR FAMILY SIZE BOLD ITALIC RUNTABS (LEN _ PARALEN) (FILEPOS _ RUNSTART) (NEWCHARLOOKS _ (create CHARLOOKS using OLDCHARLOOKS)) first [SETQ FAMILY (SETQ SIZE (SETQ BOLD (SETQ ITALIC 'OFF] until (SETQ LEN (\TFBRAVO.READNUM? BSTREAM)) do (* ;; "Some command letters are followed by numeric arguments (f1 vs b). Any spaces around command letters are skipped. BIN is used here for one-byte arguments, but perhaps a version that skips initial spaces would be safer?") (SELCHARQ (SETQ COMMAND (BIN BSTREAM)) (s (FSETCLOOKS NEWCHARLOOKS CLSTRIKE T)) (S (FSETCLOOKS NEWCHARLOOKS CLSTRIKE NIL)) (u (FSETCLOOKS NEWCHARLOOKS CLULINE T)) (U (FSETCLOOKS NEWCHARLOOKS CLULINE NIL)) (b (SETQ BOLD T)) (B (SETQ BOLD NIL)) (i (SETQ ITALIC T)) (I (SETQ ITALIC NIL)) (g "Graphic T --unsupported") (G "Graphic NIL") (v (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE NIL)) (V (AND NIL (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE T))) (t (push RUNTABS (CHARACTER (BIN BSTREAM)))) (f (* ; "Save the fontface until the end") (SETQ VALUE (CHARACTER (BIN BSTREAM))) (SETQ SIZE (\TFBRAVO.GETFONT VALUE BRSIZE)) (SETQ FAMILY (\TFBRAVO.GETFONT VALUE BRFAMILY))) (o (SETQ VALUE (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Superscript") (FSETCLOOKS NEWCHARLOOKS CLOFFSET (CL:IF (IGREATERP VALUE 127) (IDIFFERENCE VALUE 256) VALUE))) (SPACE) (CR (* ;; "We hit the trailer-terminating CR, It is either the end-marker for the last run, or a signal that this paragraph has no run-look information. ") (if (EQ 0 PARALEN) then (* ;; "If we have already accounted for all the pre-trailer characters, just return a trivial paragraph-final run pointing at the end-of-trailer CR") (SETQ RUNSTART (SUB1 (GETFILEPTR BSTREAM))) (SETQ LEN 1) (SETQ LAST T) else (\BACKFILEPTR BSTREAM) (* ;  "Leave the CR to be read on the next (PLEN=0) call.") (SETQ LEN PARALEN)) (* ;  "Otherwise, PLEN is what's left for the final substantive run") (GO $$OUT)) (\TEDIT.THELP (CHARACTER COMMAND) " is not a legal Bravo character-look command")) finally (* ;; "Wait til end to do font, so we have the bold/italic looks for sure. Last run may not have an explicit length") (\TFBRAVO.FONT.FROM.CHARLOOKS TEXTOBJ NEWCHARLOOKS FAMILY SIZE BOLD ITALIC) (* ;;  "If there are NAMEDTABS but no RUNTABS, assume that NAMEDTABS gives the name sequence") (RETURN (create RUN RUNSTART _ RUNSTART RUNLENGTH _ LEN RUNLOOKS _ NEWCHARLOOKS RUNLAST _ LAST RUNTABS _ (if RUNTABS then (DREVERSE RUNTABS) elseif NIL then (for TAB in NAMEDTABS collect (CAR TAB]) (\TFBRAVO.FONT.FROM.CHARLOOKS [LAMBDA (TEXTOBJ CHARLOOKS FAMILY SIZE BOLD ITALIC) (* ; "Edited 14-Jun-2026 15:01 by rmk") (* ; "Edited 7-Sep-2025 11:02 by rmk") (* ; "Edited 2-Jan-2025 23:43 by rmk") (* ; "Edited 1-Aug-2023 13:21 by rmk") (* ; "Edited 31-May-91 15:26 by jds") (* ;; "Takes a TEDIT CHARLOOKS with fields filled in and creates the font to fill it.") [LET ((OLDFONT (GETCLOOKS CHARLOOKS CLFONT))) (CL:WHEN (EQ FAMILY 'OFF) (SETQ FAMILY (FONTPROP OLDFONT 'FAMILY))) (CL:WHEN (EQ SIZE 'OFF) (SETQ SIZE (FONTPROP OLDFONT 'SIZE))) (CL:WHEN (EQ BOLD 'OFF) [SETQ BOLD (EQ 'BOLD (FONTPROP OLDFONT 'WEIGHT]) (CL:WHEN (EQ ITALIC 'OFF) [SETQ ITALIC (EQ 'ITALIC (FONTPROP OLDFONT 'SLOPE]) (SETCLOOKS CHARLOOKS CLFONT (FONTCREATE FAMILY SIZE (LIST (CL:IF BOLD 'BOLD 'MEDIUM) (CL:IF ITALIC 'ITALIC 'REGULAR) 'REGULAR] (\TEDIT.UNIQUIFY.CHARLOOKS CHARLOOKS TEXTOBJ]) (\TFBRAVO.READNUM? [LAMBDA (BSTREAM REQUIRED SCALE) (* ; "Edited 30-Jun-2026 22:38 by rmk") (* ; "Edited 10-Aug-2023 13:06 by rmk") (* ; "Edited 9-Aug-2023 07:53 by rmk") (* ; "Edited 5-Aug-2023 20:31 by rmk") (* ;; "If a digit appears as the first non-space character from the current stream position, the integer starting at that digit is returned. If MICAS, it is assumed that NUM is in micas and should be scaled to a multiple of 6 points (= 1/2 pica so that Tedit's margins aren't displayed as goofy decimals. The stream is left positioned before the first nondigit nonspace character.") (bind C (NUM _ 0) first (while (EQ (CHARCODE SPACE) (SETQ C (\PEEKCCODE BSTREAM T))) do (BIN BSTREAM)) (CL:UNLESS (DIGITCHARP C) (CL:WHEN REQUIRED (ERROR "Bravo command without a numeric argument at position " (GETFILEPTR BSTREAM))) (RETURN NIL)) do [SETQ NUM (IPLUS (ITIMES NUM 10) (IDIFFERENCE (BIN BSTREAM) (CHARCODE 0] repeatwhile (DIGITCHARP (\PEEKCCODE BSTREAM T)) finally (while (EQ (CHARCODE SPACE) (\PEEKCCODE BSTREAM T)) do (BIN BSTREAM)) (RETURN (SELECTQ SCALE (MICATOHALFPICAPOINTS [ITIMES 6 (FIXR (FQUOTIENT NUM (FTIMES MICASPERPT 6]) (MICATOPOINTS (FIXR (FQUOTIENT NUM MICASPERPT))) NUM]) ) (* ;; "Profile paragraphs") (DEFINEQ (\TFBRAVO.HANDLE.HEADING [LAMBDA (BSTREAM TSTREAM HEADINGSTART) (* ; "Edited 3-Jul-2026 19:19 by rmk") (* ; "Edited 1-Jul-2026 19:49 by rmk") (* ; "Edited 14-Jun-2026 15:53 by rmk") (* ; "Edited 13-Jun-2026 09:45 by rmk") (* ; "Edited 19-Feb-2025 12:17 by rmk") (* ; "Edited 8-Feb-2025 23:05 by rmk") (* ; "Edited 20-Aug-2023 20:11 by rmk") (* ; "Edited 18-Aug-2023 10:37 by rmk") (* ; "Edited 12-Aug-2023 12:25 by rmk") (* ; "Edited 9-Aug-2023 23:37 by rmk") (* ; "Edited 4-Aug-2023 10:39 by rmk") (* ; "Edited 1-Aug-2023 22:24 by rmk") (* ; "Edited 31-May-91 15:26 by jds") (* ;; "Called from \TFBRAVO.PARSE.PROFILE.PARA. The heading is a paragraph beginning at the current position, presumably just a line with a looks trailer. Its paralooks have to be marked with special heading properties--heading type and special X and Y locations.") (LET ((TEXTOBJ (FGETTSTR TSTREAM TEXTOBJ)) HEADINGDESC HEADINGPARA HEADINGPARALOOKS) (* ;  "skip over the trailer of the profile para") (SETFILEPTR BSTREAM HEADINGSTART) (SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA (GETBPROP TEXTOBJ 'USER.CM.PARALOOKS) BSTREAM TEXTOBJ)) (SETQ HEADINGPARALOOKS (fetch (PARA PARAPLOOKS) of HEADINGPARA)) (SETPLOOKS HEADINGPARALOOKS FMTPARATYPE 'PAGEHEADING) (* ;; "This is where the vertical tab info is placed for the heading, remove the special x and y and use them as the position for the descriptor") (SETQ HEADINGDESC (LIST (GENSYM 'PageHeading) (OR (FGETPLOOKS HEADINGPARALOOKS FMTSPECIALX) 0) (OR (FGETPLOOKS HEADINGPARALOOKS FMTSPECIALY) 0))) (FSETPLOOKS HEADINGPARALOOKS FMTPARASUBTYPE (CAR HEADINGDESC)) (FSETPLOOKS HEADINGPARALOOKS FMTSPECIALX (CADR HEADINGDESC)) (FSETPLOOKS HEADINGPARALOOKS FMTSPECIALY (CADDR HEADINGDESC)) (* ;  "now write out the heading paragraph") (\TFBRAVO.INSERT.PARA HEADINGPARA BSTREAM TSTREAM) HEADINGDESC]) (\TFBRAVO.PARSE.PROFILE.PARA [LAMBDA (BSTREAM PARAGRAPH TSTREAM START) (* ; "Edited 5-Jul-2026 21:02 by rmk") (* ; "Edited 3-Jul-2026 19:19 by rmk") (* ; "Edited 1-Jul-2026 19:49 by rmk") (* ; "Edited 14-Jun-2026 11:45 by rmk") (* ; "Edited 19-Feb-2025 12:17 by rmk") (* ; "Edited 8-Feb-2025 21:27 by rmk") (* ; "Edited 22-Sep-2023 20:02 by rmk") (* ; "Edited 19-Aug-2023 23:33 by rmk") (* ; "Edited 17-Aug-2023 14:51 by rmk") (* ; "Edited 10-Aug-2023 10:37 by rmk") (* ; "Edited 1-Aug-2023 13:29 by rmk") (* gbn " 3-Jun-85 17:23") (* ;; "Parse a Bravo profile paragraph, and set up the corresponding TEdit page looks, headings, page numbers.") (* ;; "START is the beginning of the profile lines, current fileptr (END) is the end of its looks information (which is kind of odd, since %"Margins: %" has no looks. At best it sets carryover tabs.") (* ;; "This code processes the profile settings, storing them away as TEXTOBJ properties for later installation. Presumably, if there are multiple valid profile paragraphs in the same file, then the settings of the last one will override earlier ones.") (* ;; "Heading lines are followed by separate paragraphs containing the formatted text of the heading. The parameters are saved in the HEADINGDESC") (* ;; "Returns T if this is truly a profile paragraph, beginning with one of the profile keywords, otherwise NIL. Either way, BSTREAM is positioned at the beginning of the next unprocessed paragraph") (* ;; "START") (bind LINE ROMAN UPPERCASE (TEXTOBJ _ (FGETTSTR TSTREAM TEXTOBJ)) (END _ (GETFILEPTR BSTREAM)) first (SETFILEPTR BSTREAM START) while (ILESSP (GETFILEPTR BSTREAM) END) do [ (* ;; "Each RATOMS reads a line, the last line including the trailer characters. ^Z is a break so processing on the last line can stop at that token. Presumably the RATOMS will have reached END (and not gone past it), but we set the fileptr back to that position just in case, to set up for the next paragraph. Semi-colon is a sepr in the readtable, we don't have to worry about those.") (SETQ LINE (U-CASE (RATOMS (CHARACTER (CHARCODE CR)) BSTREAM PROFILE.PARA.RDTBL))) (* ;; "Now we have to parse, checking and skipping the irrelevant keywords. Each keyword starts a line, each while runs until its end-token (CR?)") (SELECTQ (pop LINE) (PAGE (* ; "parse the page numbers stuff") (\TFBRAVO.ASSERT 'NUMBERS (pop LINE)) (while LINE do (SELECTQ (pop LINE) (NO (SETBPROP TEXTOBJ 'PAGENUMBERS 'NO)) (YES (* ; "this is default ") (SETBPROP TEXTOBJ 'PAGENUMBERS NIL)) (FIRST (\TFBRAVO.ASSERT 'PAGE (pop LINE)) (SETBPROP TEXTOBJ 'FIRSTPAGENO (pop LINE))) (NOT-ON-FIRST-PAGE (SETBPROP TEXTOBJ 'PAGENUMBER.NOTONFIRSTPAGE T)) (X (SETBPROP TEXTOBJ 'PAGENUMBERX (\TOPOINTS 'WIDTH))) (Y (SETBPROP TEXTOBJ 'PAGENUMBERY (\TOPOINTS 'HEIGHT))) (ROMAN (SETQ ROMAN T)) (UPPERCASE (SETQ UPPERCASE T)) NIL))) (COLUMNS (* ; "parse the columns numbers stuff") (SETBPROP TEXTOBJ 'NUMBEROFCOLUMNS (pop LINE)) (while LINE do (SELECTQ (pop LINE) (EDGE (\TFBRAVO.ASSERT 'MARGIN (pop LINE)) (SETBPROP TEXTOBJ 'EDGEMARGIN (\TOPOINTS 'WIDTH))) (BETWEEN (\TFBRAVO.ASSERT 'COLUMNS (pop LINE)) (SETBPROP TEXTOBJ 'BETWEENCOLUMNS (\TOPOINTS 'WIDTH))) NIL))) (MARGINS (* ; "parse the margins stuff") (while LINE do (SELECTQ (pop LINE) (TOP (SETBPROP TEXTOBJ 'TOPMARGIN (\TOPOINTS 'HEIGHT))) (BOTTOM (SETBPROP TEXTOBJ 'BOTTOMMARGIN (\TOPOINTS 'HEIGHT))) (BINDING (SETBPROP TEXTOBJ 'BINDING (\TOPOINTS))) NIL))) (ODD (\TFBRAVO.ASSERT 'HEADING (pop LINE)) (CL:WHEN (EQ (CAR LINE) 'NOT-ON-FIRST-PAGE) (pop LINE) (SETBPROP TEXTOBJ 'RIGHTHEADING.NOTONFIRSTPAGE T)) (* ; "Heading is on the next line") (SETBPROP TEXTOBJ 'RIGHTHEADINGLIST (LIST (\TFBRAVO.HANDLE.HEADING BSTREAM TSTREAM END))) (* ;; "We advance past the heading paragraph, presumably we are done.") (SETQ END (GETFILEPTR BSTREAM))) (EVEN (\TFBRAVO.ASSERT (pop LINE) 'HEADING) (CL:WHEN (EQ (CAR LINE) 'NOT-ON-FIRST-PAGE) (pop LINE) (SETBPROP TEXTOBJ 'LEFTHEADING.NOTONFIRSTPAGE T)) (SETBPROP TEXTOBJ 'LEFTHEADINGLIST (LIST (\TFBRAVO.HANDLE.HEADING BSTREAM TSTREAM END))) (SETQ END (GETFILEPTR BSTREAM))) (HEADING (CL:WHEN (EQ (CAR LINE) 'NOT-ON-FIRST-PAGE) (pop LINE) (SETBPROP TEXTOBJ 'HEADING.NOTONFIRSTPAGE T)) (SETBPROP TEXTOBJ 'DEFAULTHEADINGLIST (LIST (\TFBRAVO.HANDLE.HEADING BSTREAM TSTREAM END))) (SETQ END (GETFILEPTR BSTREAM))) ((LINE PRIVATE) (* ;  "Line numbers, private data not supported") NIL) (PROGN (* ;  "Not a profile line, presumably a mistaken q.") (SETFILEPTR BSTREAM END) (FSETPLOOKS (fetch (PARA PARAPLOOKS) of PARAGRAPH) FMTPARATYPE NIL) (RETURN NIL] repeatuntil [EQ (CAR LINE) (CONSTANT (CHARACTER (CHARCODE ^Z] finally (CL:WHEN ROMAN (SETBPROP TEXTOBJ 'ROMAN (CL:IF UPPERCASE 'X 'x))) (* ;; "Set the file to the beginning of the next paragraph") (SETFILEPTR BSTREAM END) (RETURN T]) ) (* ;; "Creating the text stream") (DEFINEQ (\TFBRAVO.INSERT.PARA [LAMBDA (PARA BSTREAM TSTREAM) (* ; "Edited 2-Aug-2026 21:25 by rmk") (* ; "Edited 5-Jul-2026 22:06 by rmk") (* ; "Edited 14-Jun-2026 14:48 by rmk") (* ; "Edited 8-Feb-2025 23:06 by rmk") (* ; "Edited 20-Aug-2023 16:13 by rmk") (* ;; "Inserts pieces into TEXTOBJ that correspond to the charlooks runs in PARA. The runs in PARA may have internal formatting characters (CR, LF, TAB, FORM) that have to be split out in separate pieces.") (* ;;  "PARATABDEFS of PARA contains the definitions of named tags, for all the runs of this paragraph.") (* ;; "RUNTABS contains a list of named tags that are explicity specified for this run, by tn entries in the charlooks. If RUNTABS is empty, then the successive tab characters in the FORMATPTRS are paired with the successive tabs in the PARATABDEFS.") (* ;; "However they are identified, named tabs are converted to image objects that either replace the successive tab characters") (DECLARE (USEDFREE NAMEDTABS)) (for RUN PC UNSETNEXTTAB TABNAME TABX PARALOOKS RUNSTARTCHNO RUNTABS (TEXTOBJ _ (FGETTSTR TSTREAM TEXTOBJ)) [FILEPOS _ (fetch (RUN RUNSTART) of (CAR (fetch (PARA RUNS) of PARA] in (fetch (PARA RUNS) of PARA) first (SETQ PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (fetch (PARA PARAPLOOKS) of PARA) TEXTOBJ)) when (IGREATERP (fetch (RUN RUNLENGTH) of RUN) 0) do (AND NIL (\TFBRAVO.RUN.TABSPEC RUN PARALOOKS TEXTOBJ)) (SETQ RUNSTARTCHNO (ADD1 (TEXTLEN TEXTOBJ))) (SETQ RUNTABS (fetch (RUN RUNTABS) of RUN)) (SETQ PC (create PIECE PTYPE _ THINFILE.PTYPE PCONTENTS _ BSTREAM PFPOS _ FILEPOS PLEN _ (fetch (RUN RUNLENGTH) of RUN) PBYTESPERCHAR _ 1 PCHARLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (RUN RUNLOOKS) of RUN) TEXTOBJ) PPARALOOKS _ PARALOOKS)) (* ;;  "Insert a piece for the run, then walk through and chop it up to replace any formatting characters") (\TEDIT.INSERTPIECE PC NIL TEXTOBJ) (for FPTR TABX in (fetch (RUN RUNFORMATPTRS) of RUN) do (* ;; "FPTR's are run-relative") (SELECTQ (CAR FPTR) (EOL (\TEDIT.NTHCHARCODE TSTREAM (IPLUS RUNSTARTCHNO (CADR FPTR))) (\TEDIT.RPLCHARCODE TSTREAM (IPLUS RUNSTARTCHNO (CADR FPTR)) (CHARCODE Meta,EOL))) (TAB (CL:WHEN (AND RUNTABS NAMEDTABS) (* ;  "If not named, leave as an interval tab") (SETQ TABNAME (pop RUNTABS)) (if (EQ TABNAME 0) then (* ;; "Unset the next tab, leave it as a tab character?") (SETQ UNSETNEXTTAB T) else (CL:WHEN (AND TABNAME (NOT UNSETNEXTTAB) (SETQ TABX (GETMULTI NAMEDTABS TABNAME))) (* ;  "Replace the named TAB with a tab image object") (\TEDIT.RPLCHARCODE TSTREAM (IPLUS RUNSTARTCHNO (CADR FPTR)) (TEDIT.TABOBJ (IDIFFERENCE TABX (GETPLOOKS PARALOOKS LEFTMAR)) TABNAME))) (SETQ UNSETNEXTTAB NIL)))) (FORM (* ;  "Pargraph break or leave alone? Not sure")) (SHOULDNT))) (add FILEPOS (fetch (RUN RUNLENGTH) of RUN)) finally (* ;; "Replace ^z with EOL, but maybe no ^z at EOF. OFFSET is alredy PC-relative") (CL:WHEN [EQ (CHARCODE ^z) (\TEDIT.PIECE.NTHCHARCODE PC (SUB1 (PLEN PC] (\TEDIT.PIECE.RPLCHARCODE TSTREAM PC (SUB1 (PLEN PC)) (CHARCODE EOL)))]) (\TFBRAVO.INSERT.RUN [LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ) (* ; "Edited 30-Jun-2026 21:30 by rmk") (* ; "Edited 10-Apr-2026 09:22 by rmk") (* ; "Edited 28-Jul-2025 23:33 by rmk") (* ; "Edited 8-Feb-2025 23:08 by rmk") (* ; "Edited 17-Mar-2024 12:41 by rmk") (* ; "Edited 16-Jan-2024 18:28 by rmk") (* ; "Edited 29-Dec-2023 11:50 by rmk") (* ; "Edited 23-Sep-2023 12:11 by rmk") (* ; "Edited 23-Aug-2023 08:31 by rmk") (* ; "Edited 20-Aug-2023 16:12 by rmk") (* ; "Edited 19-Aug-2023 14:47 by rmk") (* ;; "A Bravo run can include many CR's each of which should end a separate TEDIT paragraph. Unless we want to think of those as paragraph internal meta-CRs ?") (* ;; "PARALOOKS is the intended paragraph PARALOOKS for the paragraph, providing the margins, line leading etc. common to all runs. It may be specialized for each run to encode the tabs that that run actually selects (via \TFBRAVO.RUN.TABSPEC") (CL:WHEN (IGREATERP (fetch (RUN RUNLENGTH) of RUN) 0) (* ; "No need for an empty piece") (LET ((NCHARS (fetch (RUN RUNLENGTH) of RUN)) (RUNSTART (fetch (RUN RUNSTART) of RUN)) PC) (SETQ PC (create PIECE PTYPE _ THINFILE.PTYPE PCONTENTS _ BSTREAM PFPOS _ RUNSTART PLEN _ NCHARS PBYTESPERCHAR _ 1 PCHARLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (RUN RUNLOOKS) of RUN) TEXTOBJ) PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ) PPARALAST _ (fetch (RUN RUNLAST) of RUN))) (\TEDIT.INSERTPIECE PC NIL TEXTOBJ) PC))]) (\TFBRAVO.RUN.TABSPEC [LAMBDA (RUN PARALOOKS TEXTOBJ) (* ; "Edited 4-Jul-2026 00:09 by rmk") (* ; "Edited 14-Jun-2026 14:48 by rmk") (* ; "Edited 19-Feb-2025 12:16 by rmk") (* ; "Edited 8-Feb-2025 23:15 by rmk") (* ; "Edited 27-Aug-2024 22:02 by rmk") (* ; "Edited 28-Jul-2024 21:30 by rmk") (* ; "Edited 15-Mar-2024 19:42 by rmk") (* ; "Edited 22-Aug-2023 16:54 by rmk") (* ; "Edited 19-Aug-2023 15:47 by rmk") (* ;; "The CLUSERINFO contains a list of named tabs specified for this and presumably defined in the paragraph-wide PARALOOKS. This returns a PARALOOKS for this run that only includes the named tabs that this run calls for.") (* ;; "") (* ;; "For the first run, the PARALOOKS is the unspecialized run for the paragraph, with empty TABSPEC. Each subsequent run is given the PARALOOKS for the last run, so the tabs that were selected there are known. This is because t0 is loosely specified as picking the next tab in the FMTUSERINFO after the last tab that was used in the previous run (I think). (Or perhaps as setting the next tabs TABX as the interval?)") (* ;; "") (* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different PARALOOKS. ") (* ;; "") (* ;; "NOTE: the names in the tab definitions have been bumped up by 1 to match the names in the tab looks (e.g. (0,xxx) is (1,xxx) to correspond to t1. t0 doesn't match.") (LET ([LASTTAB (CAR (LAST (GETPLOOKS PARALOOKS FMTTABS] (TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO)) (TABDEFAULT (OR (FGETPLOOKS PARALOOKS FMTDEFAULTTAB) (FGETPLOOKS (GETBPROP TEXTOBJ 'USER.CM.PARALOOKS) FMTDEFAULTTAB))) (RUNTABS (fetch (RUN RUNFORMATPTRS) of RUN)) TAB TABS) (CL:WHEN (AND TABDEFS (NULL RUNTABS)) (SETQ RUNTABS (CONS (CAAR TABDEFS)))) (CL:WHEN (AND TABDEFS RUNTABS) (CL:WHEN (EQUAL RUNTABS '(0)) (* ;  "If e.g. Tab 0 is set but the run has no tn's, assume that the first tn is intended.") (SETQ RUNTABS '(1 2))) [SETQ TABS (for TABNAME in RUNTABS collect (* ;;  "For t0 we try to find the tab after the one last used in the previous run.") (if (CDR (ASSOC TABNAME TABDEFS)) elseif [AND (EQ TABNAME 0) (for TDTAIL TD on TABDEFS eachtime (SETQ TD (CAR TDTAIL)) when (EQ LASTTAB (CDR TD)) do [SETQ TABDEFAULT (fetch TABX of (CDR (CADR TDTAIL] (RETURN (CDR (CADR TDTAIL] else (GO $$ITERATE] (* ;; "This asserts that the tabdefs are constant across a paragraph, that the right number of tabs are on each line in a paragraph. That assumption is mostly reasonable, given the paragraph splitting. The code above allows each run (piece) to have its own tab settings. Although \TEDIT.FORMATLINE.UPDATELOOKS can easily be modified to allow the pieces on a line to change their tab definitions, the paragraph-looks menu assumes that tabs are constant across a paragraph. So things would go bonkers.") [SETQ TABS (SORT (for TAB in TABDEFS collect (CDR TAB)) (FUNCTION (LAMBDA (T1 T2) (ILEQ (fetch (TAB TABX) of T1) (fetch (TAB TABX) of T2] (SETQ PARALOOKS (create PARALOOKS using PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS _ TABS))) PARALOOKS]) (\TFBRAVO.INSTALL.PAGEFORMAT [LAMBDA (TSTREAM) (* ; "Edited 7-Jul-2026 01:00 by rmk") (* ; "Edited 5-Jul-2026 23:01 by rmk") (* ; "Edited 15-Jun-2026 13:43 by rmk") (* ; "Edited 22-Sep-2023 20:04 by rmk") (* ; "Edited 17-Aug-2023 14:31 by rmk") (* ; "Edited 13-Jun-90 01:00 by mitani") (* ;; "using the information from the profile paragraphs, this function installs the pageframes") (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) FIRSTPAGENO PAGENUMBERS TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS BETWEENCOLUMNS COLUMNWIDTH HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE RIGHTHEADING.NOTONFIRSTPAGE LEFTHEADING.NOTONFIRSTPAGE FIRST LEFT RIGHT PAGEPROPS LEFTPAGENUMPARA RIGHTPAGENUMPARA FIRSTHEADINGLIST LEFTHEADINGLIST DEFAULTHEADINGLIST RIGHTHEADINGLIST FIRSTHEADINGLIST PAGENUMBERY BINDING EDGEMARGIN) (DECLARE (SPECVARS . T)) (for VAR in '(FIRSTPAGENO PAGENUMBERS TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS COLUMNWIDTH BETWEENCOLUMNS LEFTHEADINGLIST DEFAULTHEADINGLIST RIGHTHEADINGLIST HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE RIGHTHEADING.NOTONFIRSTPAGE LEFTHEADING.NOTONFIRSTPAGE PAGENUMBERY BINDING EDGEMARGIN) do (SET VAR (GETBPROP TEXTOBJ VAR))) (* ;; "This assumes that TEdit does not build a default page spec. If it ever does, then this logic must change.") (* ;; "the default page frame is always built. It is sometimes built as the only page frame when there is no headings specified. However, if heading is specified with the not-on-first-page specified, then we must build the default page frame simply for that reason") (CL:WHEN NUMBEROFCOLUMNS (* ;; "If this is to be printed multicolumn then determine the column width from the numberofcolumns and the space between them. ") (SETQ COLUMNWIDTH (IQUOTIENT (IDIFFERENCE [IDIFFERENCE (CONSTANT (TIMES 8.5 PTSPERINCH)) (ITIMES 2 (GETBPROP TEXTOBJ 'EDGEMARGIN] (ITIMES (SUB1 NUMBEROFCOLUMNS) BETWEENCOLUMNS)) NUMBEROFCOLUMNS))) (* ;; "") (* ;; "Headings. Bravo specifies the position of the left") (CL:UNLESS LEFTHEADINGLIST (SETQ LEFTHEADINGLIST DEFAULTHEADINGLIST)) (CL:UNLESS RIGHTHEADINGLIST (SETQ RIGHTHEADINGLIST DEFAULTHEADINGLIST)) (CL:UNLESS HEADING.NOTONFIRSTPAGE (* ; "Is left a fallback option?") (SETQ FIRSTHEADINGLIST (OR (CL:UNLESS RIGHTHEADING.NOTONFIRSTPAGE RIGHTHEADINGLIST) DEFAULTHEADINGLIST (CL:UNLESS LEFTHEADING.NOTONFIRSTPAGE LEFTHEADINGLIST)))) (CL:UNLESS BINDING (SETQ BINDING 0)) (SETQ BINDING 0) (* ;; "") (* ;; "Page numbers") (CL:UNLESS (EQ PAGENUMBERS 'NO) (* ;  "Since PAGENO is in objects, disable folios ") [change PAGENUMBERY (DIFFERENCE DATUM (FONTPROP (GETCLOOKS (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS) CLFONT) 'ASCENT] [SETQ PAGEPROPS `(STARTINGPAGE# ,(OR FIRSTPAGENO 1] (SETQ LEFTPAGENUMPARA (\TEDIT.PAGENO.PARAGRAPH TEXTOBJ 'Leftpagenumber (GETBPROP TEXTOBJ 'ROMAN) 0 PAGENUMBERY 'LEFT)) (SETQ RIGHTPAGENUMPARA (\TEDIT.PAGENO.PARAGRAPH TEXTOBJ 'Rightpagenumber (GETBPROP TEXTOBJ 'ROMAN) (GETBPROP TEXTOBJ 'PAGENUMBERX) PAGENUMBERY 'RIGHT)) (\TEDIT.INSERT.SELPIECES RIGHTPAGENUMPARA TSTREAM 1) (* ; "Left ends up in front of right") (\TEDIT.INSERT.SELPIECES LEFTPAGENUMPARA TSTREAM 1) (CL:UNLESS PAGENUMBER.NOTONFIRSTPAGE (push FIRSTHEADINGLIST (LIST 'Rightpagenumber 0 PAGENUMBERY))) (push LEFTHEADINGLIST (LIST 'Leftpagenumber 0 PAGENUMBERY)) (push RIGHTHEADINGLIST (LIST 'Rightpagenumber 0 PAGENUMBERY))) (* ;; "") (* ;; "Page formats") (SETQ FIRST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL (MINUS BINDING) 0 TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS COLUMNWIDTH BETWEENCOLUMNS FIRSTHEADINGLIST 'POINTS PAGEPROPS)) (SETQ LEFT (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL (MINUS BINDING) 0 TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS COLUMNWIDTH BETWEENCOLUMNS LEFTHEADINGLIST 'POINTS PAGEPROPS)) (SETQ RIGHT (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL BINDING 0 TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS COLUMNWIDTH BETWEENCOLUMNS RIGHTHEADINGLIST 'POINTS PAGEPROPS)) (TEDIT.PAGEFORMAT TEXTOBJ (TEDIT.COMPOUND.PAGEFORMAT FIRST LEFT RIGHT]) ) (DEFINEQ (\TFBRAVO.ASSERT [LAMBDA (X Y) (* ; "Edited 21-Oct-2024 00:27 by rmk") (* ; "Edited 9-Aug-2023 10:32 by rmk") (* gbn "19-Sep-84 21:39") (CL:UNLESS (EQ X Y) (\TEDIT.THELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y " was found.")))]) (\TEST.CHARACTER.LOOKS [LAMBDA (BSTREAM) (* ; "Edited 17-Aug-2023 09:18 by rmk") (* ; "Edited 2-Aug-2023 07:48 by rmk") (* ; "Edited 29-Jul-2023 20:25 by rmk") (* gbn " 6-Feb-84 19:11") (* ;; "returns nil until done when it returns BADLOOKS or T") (PROG (PROPERTY VALFLAG TEM (VALUE 0) CHAR) LP (while [FIXP (SETQ CHAR (FCHARACTER (BIN BSTREAM] do (SETQ VALUE CHAR) (SETQ VALFLAG T)) (COND (PROPERTY (CL:UNLESS VALFLAG (RETURN 'BADLOOKS)) (SETQ PROPERTY NIL)) (VALFLAG [SETFILEPTR BSTREAM (IDIFFERENCE (GETFILEPTR BSTREAM) (COND ([EQ CHAR (CONSTANT (CHARACTER (CHARCODE CR] 2) (T 1] (RETURN NIL))) [COND ((SETQ TEM (SELECTQ CHAR ((s u b i g v S U B I G V) T) NIL)) T (SETQ PROPERTY T)) ((SETQ TEM (SELECTQ CHAR ((t f o) T) NIL)) T) ([EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] (RETURN T)) ((NEQ CHAR '% ) (RETURN 'BADLOOKS] (SETQ VALUE 0) (SETQ VALFLAG NIL) (GO LP]) (\TEST.PARAGRAPH.LOOKS [LAMBDA (BSTREAM) (* ; "Edited 5-Aug-2023 10:58 by rmk") (* ; "Edited 2-Aug-2023 07:46 by rmk") (* gbn " 6-Feb-84 18:30") (* ;; "test if the sequence form valid paragraph looks, do not allow empty paragraph looks") (PROG ((VALUE 0) CHAR PROPERTY TABS NONEMPTY) LP (while [FIXP (SETQ CHAR (FCHARACTER (BIN BSTREAM] do (SETQ VALUE CHAR)) [COND ((SELECTQ PROPERTY ((l d z x e y k j c q) (SETQ NONEMPTY T)) NIL) (* ; "keep going, these are all ok") NIL) (T (SELECTQ PROPERTY (%( (SELECTQ CHAR (%) (SETQ NONEMPTY T)) (%, (COND ((IGREATERP VALUE 14) (* ; "not a legal tab no") (RETURN NIL)) (T (SETQ NONEMPTY T))) T) (RETURN NIL))) (%, (SETQ NONEMPTY T)) ((%) (SETQ NONEMPTY T))) (RETURN NIL] (* ; "not a legal paragraph look") (COND ((AND [NEQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] (NEQ CHAR '\)) (SETQ PROPERTY CHAR) (SETQ VALUE 0) (GO LP))) (RETURN (AND NONEMPTY CHAR]) ) (RPAQ? TEDIT.DEFAULT.USER.CM '((ParagraphLeading 12) (LineLeading 6) (FirstLineLeftMargin 84) (LeftMargin 84) (RightMargin 528) (DefaultTab 36) (Font (0 TIMESROMAN 10 NIL NIL) (1 TIMESROMAN 8 NIL NIL) (2 HIPPO 8 NIL NIL) (3 GACHA 8 NIL NIL) (4 MATH 8 NIL NIL) (5 HELVETICA 12 NIL NIL) (6 GACHA 6 NIL NIL) (7 TIMESROMAN 9 NIL NIL) (8 HELVETICA 10 NIL NIL) (9 HELVETICA 11 NIL NIL)))) (RPAQ? USER.CM.RDTBL (COPYREADTABLE)) (RPAQ? PROFILE.PARA.RDTBL (COPYREADTABLE)) (SETBRK (CHARCODE (%, %: = CR)) NIL USER.CM.RDTBL) (SETSEPR '(% ) NIL USER.CM.RDTBL) (SETSYNTAX (CHARCODE %:) 'SEPRCHAR PROFILE.PARA.RDTBL) (SETSYNTAX (CHARCODE CR) 'BREAKCHAR PROFILE.PARA.RDTBL) (SETSYNTAX (CHARCODE ^Z) 'BREAKCHAR PROFILE.PARA.RDTBL) (* ; "Named tabs. ") (DEFINEQ (TEDIT.TABOBJ [LAMBDA (POSITION NAME) (* ; "Edited 5-Jul-2026 21:55 by rmk") (* ; "Edited 4-Jul-2026 21:27 by rmk") (IMAGEOBJCREATE (LIST POSITION NAME) \TEDIT.NAMEDTAB.IMAGEFNS]) (\TFBRAVO.ADD.NAMEDTAB [LAMBDA (RUN PARALOOKS TEXTOBJ) (* ; "Edited 19-Feb-2025 12:17 by rmk") (* ; "Edited 8-Feb-2025 23:19 by rmk") (* ; "Edited 4-Aug-2024 18:05 by rmk") (* ; "Edited 28-Jul-2024 21:29 by rmk") (* ; "Edited 9-Sep-2023 21:44 by rmk") (* ; "Edited 18-Aug-2023 18:42 by rmk") (* ; "Edited 15-Aug-2023 00:26 by rmk") (* ; "Edited 13-Aug-2023 19:56 by rmk") (* ;; "The CLUSERINFO contains a list of tab-looks appearing in this run, and FMTUSERINFO contains the definition of tabs that have been declared in this paragraph or inherited from previous paragraphs. ") (* ;; "") (* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different PARALOOKS. ") (* ;; "") (* ;; "THIS IS NOT USED, TO BE REMOVED. RUNTABOFFSETS DOESN'T EXIST") (NOTUSED) (LET ((RUNLOOKS (fetch (RUN RUNLOOKS) of RUN)) (TABDEFS (FGETPLOOKS PARALOOKS FMTUSERINFO)) (TABDEFAULT (FGETPLOOKS PARALOOKS FMTDEFAULTTAB)) (TABOFFSETS '(fetch (RUN RUNTABOFFSETS) of RUN)) TAB TABNAMES TABS) (SETQ TABNAMES (fetch (CHARLOOKS CLUSERINFO) of RUNLOOKS)) (CL:WHEN TABDEFS [if TABNAMES then (SETQ TABS (for TN in TABNAMES eachtime (add TN -1) when (SETQ TAB (CDR (ASSOC TN TABDEFS))) unless (EQ TAB T) until (EQ TN -1) collect TAB)) elseif (CDR TABDEFS) then (* ;; "If the run has no names, then assume that its first TAB aligns at the earliest defined tab, next aligns at the second, etc. Sort tabs by increasing TABX, not names. ") [SETQ TABS (SORT (for TD in TABDEFS collect (CDR TD)) (FUNCTION (LAMBDA (T1 T2) (ILEQ (fetch (TAB TABX) of T1) (fetch (TAB TABX) of T2] elseif (EQ 0 (CAR (CAR TABDEFS))) then (* ;;  "No name and 0, make it be the default. How else would we decide where the second tab goes?") (SETQ TABDEFAULT (fetch (TAB TABX) of (CDAR TABDEFS] (CL:WHEN (OR TABS (NEQ TABDEFAULT (FGETPLOOKS PARALOOKS FMTDEFAULTTAB))) (SETQ PARALOOKS (create PARALOOKS using PARALOOKS FMTDEFAULTTAB _ TABDEFAULT FMTTABS _ TABS)) (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ))) PARALOOKS]) (\TEDIT.NAMEDTAB.DISPLAY [LAMBDA (OBJ IMAGESTREAM IMAGESTREAMTYPE) (* ; "Edited 2-Jul-2026 23:38 by rmk") (* ; "Edited 1-Jul-2026 23:28 by rmk") (AND NIL (PRINTOUT IMAGESTREAM "[" (IMAGEOBJPROP OBJ 'OBJECTDATUM) "]"]) (\TEDIT.NAMEDTAB.BUTTONEVENT [LAMBDA (OBJ WDS SEL RELX RELY WINDOW TSTREAM) (* ; "Edited 5-Jul-2026 21:56 by rmk") (* ; "Edited 4-Jul-2026 21:27 by rmk") (LET [(DATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM] (if (LISTP DATUM) then (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Named tab " (CADR DATUM) " at " (CAR DATUM) " points") T) else (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Tab at" (CAR DATUM) " points") T]) (\TEDIT.NAMEDTAB.COPY [LAMBDA (OBJ PIECE OLDCH NEWCH) (* jds " 8-Feb-84 19:58") (* just creates a named tab stop with  the same value as the original) (* Note that the USING phrase will create a new TEDITOBJ as well as a  TEDITUSEROBJ) (COPY OBJ]) (\TEDIT.NAMEDTAB.PUT [LAMBDA (OBJ CHARSTREAM) (* ; "Edited 5-Jul-2026 22:26 by rmk") (* jds " 8-Feb-84 19:59") (* ;; "Writes the position of the tab so that a new one can be created on read") (PRINT (IMAGEOBJPROP OBJ 'OBJECTDATUM) CHARSTREAM (FIND-READTABLE "INTERLISP"]) (\TEDIT.NAMEDTAB.GET [LAMBDA (CHARSTREAM TEXTSTREAM) (* ; "Edited 5-Jul-2026 22:28 by rmk") (* ; "Edited 30-Jun-2026 21:03 by rmk") (* jds " 8-Feb-84 19:59") (* ;; "Reads the position, create an obj and return it") (IMAGEOBJCREATE (READ CHARSTREAM (FIND-READTABLE "INTERLISP")) \TEDIT.NAMEDTAB.IMAGEFNS]) (\TEDIT.NAMEDTAB.IMAGEBOX [LAMBDA (TABOBJECT IMAGESTREAM CURRENTX) (* ; "Edited 5-Jul-2026 22:09 by rmk") (* ; "Edited 2-Jul-2026 23:39 by rmk") (* ; "Edited 30-Jun-2026 21:15 by rmk") (* ; "Edited 6-Aug-2023 14:24 by rmk") (* gbn "19-May-84 22:52") (* ;; "The OBJECTDATUM is the tab position in points.") (create IMAGEBOX XSIZE _ (IMAX 1 (IDIFFERENCE [HCSCALE (DSPSCALE NIL IMAGESTREAM) (CAR (IMAGEOBJPROP TABOBJECT 'OBJECTDATUM] CURRENTX)) YSIZE _ 1 YDESC _ 0 XKERN _ 0]) (\TEDIT.NAMEDTAB.PREPRINT [LAMBDA (TABOBJ) (* ; "Edited 5-Jul-2026 21:55 by rmk") (* ; "Edited 2-Jul-2026 23:39 by rmk") (* ; "Edited 6-Aug-2023 18:56 by rmk") (if (LISTP TABOBJ) then (CONCAT "[Tab " (CADR TABOBJ) " at " (CAR TABOBJ) "]") else (CONCAT "[Tab at " (CAR TABOBJ) "]"]) (\TEDIT.NAMEDTAB.INIT [LAMBDA NIL (* ; "Edited 4-Jul-2026 17:24 by rmk") (* ; "Edited 2-Jul-2026 00:33 by rmk") (* ; "Edited 17-Mar-2024 18:26 by rmk") (* ; "Edited 6-Aug-2023 18:59 by rmk") (* jds "22-Aug-84 14:49") (SETQ \TEDIT.NAMEDTAB.IMAGEFNS (IMAGEFNSCREATE (FUNCTION \TEDIT.NAMEDTAB.DISPLAY) (FUNCTION \TEDIT.NAMEDTAB.IMAGEBOX) (FUNCTION \TEDIT.NAMEDTAB.PUT) (FUNCTION \TEDIT.NAMEDTAB.GET) (FUNCTION \TEDIT.NAMEDTAB.COPY) (FUNCTION \TEDIT.NAMEDTAB.BUTTONEVENT) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION \TEDIT.NAMEDTAB.PREPRINT]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \TEDIT.NAMEDTAB.IMAGEFNS) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (\TEDIT.NAMEDTAB.INIT) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (7715 14875 (BRAVOFILEP 7725 . 9912) (TEDITFROMBRAVO 9914 . 14873)) (15150 32373 ( \TFBRAVO.GET.USER.CM 15160 . 18488) (\TFBRAVO.USER.CM.LOOKS 18490 . 20009) (\TFBRAVO.READ.USER.CM 20011 . 24896) (\TFBRAVO.INIT.PARALOOKS 24898 . 27401) (\TFBRAVO.INIT.PAGEFORMAT 27403 . 28368) ( \TFBRAVO.GETPARAMS 28370 . 31224) (\TFBRAVO.FIND.LAST.TRAILER 31226 . 32371)) (32415 56573 ( \TFBRAVO.PARSE.PARA 32425 . 37525) (\TFBRAVO.READ.PARALOOKS 37527 . 45074) (\TFBRAVO.CREATE.RUNS 45076 . 47174) (\TFBRAVO.READ.CHARLOOKS 47176 . 52865) (\TFBRAVO.FONT.FROM.CHARLOOKS 52867 . 54565) ( \TFBRAVO.READNUM? 54567 . 56571)) (56610 68517 (\TFBRAVO.HANDLE.HEADING 56620 . 59827) ( \TFBRAVO.PARSE.PROFILE.PARA 59829 . 68515)) (68560 87568 (\TFBRAVO.INSERT.PARA 68570 . 73775) ( \TFBRAVO.INSERT.RUN 73777 . 76356) (\TFBRAVO.RUN.TABSPEC 76358 . 81455) (\TFBRAVO.INSTALL.PAGEFORMAT 81457 . 87566)) (87569 91712 (\TFBRAVO.ASSERT 87579 . 88109) (\TEST.CHARACTER.LOOKS 88111 . 89997) ( \TEST.PARAGRAPH.LOOKS 89999 . 91710)) (92709 102115 (TEDIT.TABOBJ 92719 . 93033) ( \TFBRAVO.ADD.NAMEDTAB 93035 . 96638) (\TEDIT.NAMEDTAB.DISPLAY 96640 . 96983) ( \TEDIT.NAMEDTAB.BUTTONEVENT 96985 . 97776) (\TEDIT.NAMEDTAB.COPY 97778 . 98224) (\TEDIT.NAMEDTAB.PUT 98226 . 98647) (\TEDIT.NAMEDTAB.GET 98649 . 99154) (\TEDIT.NAMEDTAB.IMAGEBOX 99156 . 100079) ( \TEDIT.NAMEDTAB.PREPRINT 100081 . 100667) (\TEDIT.NAMEDTAB.INIT 100669 . 102113))))) STOP