Models.txt 63 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085
  1. MODULE TextModels;
  2. (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Text/Mod/Models.odc *)
  3. (* DO NOT EDIT *)
  4. (* re-check alien attributes: project to base attributes? *)
  5. (* support *lists* of attribute extensions? *)
  6. (* support for enumeration of texts within embedded views
  7. - generally: support for enumeration of X-views within a recursive scheme?
  8. - however: Containers already provides a general iteration scheme
  9. -> could add recursion support to Reader later
  10. *)
  11. IMPORT
  12. Files, Services, Fonts, Ports, Stores, Models, Views, Properties, Containers;
  13. (* text file format:
  14. text = 0 CHAR
  15. textoffset INTEGER (> 0)
  16. { run }
  17. -1 CHAR
  18. { char }
  19. run = attrno BYTE (0..32)
  20. [ attr ] attr.Internalize
  21. ( piece | lpiece | viewref )
  22. piece = length INTEGER (> 0)
  23. lpiece = -length INTEGER (< 0, length MOD 2 = 0)
  24. viewref = 0 INTEGER
  25. w INTEGER
  26. h INTEGER
  27. view view.Internalize
  28. *)
  29. CONST
  30. (* unicode* = 1X; *)
  31. viewcode* = 2X; (** code for embedded views **)
  32. tab* = 9X; line* = 0DX; para* = 0EX; (** tabulator; line and paragraph separator **)
  33. zwspace* = 8BX; nbspace* = 0A0X; digitspace* = 8FX;
  34. hyphen* = 90X; nbhyphen* = 91X; softhyphen* = 0ADX;
  35. (** Pref.opts, options of text-aware views **)
  36. maskChar* = 0; hideable* = 1;
  37. (** Prop.known/valid/readOnly **)
  38. offset* = 0; code* = 1;
  39. (** InfoMsg.op **)
  40. store* = 0;
  41. (** UpdateMsg.op **)
  42. replace* = 0; insert* = 1; delete* = 2;
  43. (* EditOp.mode *)
  44. deleteRange = 0; moveBuf = 1; writeSChar = 2; writeChar = 3; writeView = 4;
  45. dictSize = 32;
  46. point = Ports.point;
  47. defW = 64 * point; defH = 32 * point;
  48. (* embedding limits - don't increase maxHeight w/o checking TextViews.StdView *)
  49. minWidth = 5 * point; maxWidth = MAX(INTEGER) DIV 2;
  50. minHeight = 5 * point; maxHeight = 1500 * point;
  51. minVersion = 0; maxAttrVersion = 0; maxModelVersion = 0;
  52. noLCharStdModelVersion = 0; maxStdModelVersion = 1;
  53. cacheWidth = 8; cacheLen = 4096; cacheLine = 128;
  54. TYPE
  55. Model* = POINTER TO ABSTRACT RECORD (Containers.Model) END;
  56. Attributes* = POINTER TO EXTENSIBLE RECORD (Stores.Store)
  57. init-: BOOLEAN; (* immutable once init is set *)
  58. color-: Ports.Color;
  59. font-: Fonts.Font;
  60. offset-: INTEGER
  61. END;
  62. AlienAttributes* = POINTER TO RECORD (Attributes)
  63. store-: Stores.Alien
  64. END;
  65. Prop* = POINTER TO RECORD (Properties.Property)
  66. offset*: INTEGER;
  67. code*: CHAR
  68. END;
  69. Context* = POINTER TO ABSTRACT RECORD (Models.Context) END;
  70. Pref* = RECORD (Properties.Preference)
  71. opts*: SET; (** preset to {} **)
  72. mask*: CHAR (** valid if maskChar IN opts **)
  73. END;
  74. Reader* = POINTER TO ABSTRACT RECORD
  75. eot*: BOOLEAN;
  76. attr*: Attributes;
  77. char*: CHAR;
  78. view*: Views.View;
  79. w*, h*: INTEGER
  80. END;
  81. Writer* = POINTER TO ABSTRACT RECORD
  82. attr-: Attributes
  83. END;
  84. InfoMsg* = RECORD (Models.Message)
  85. op*: INTEGER
  86. END;
  87. UpdateMsg* = RECORD (Models.UpdateMsg)
  88. op*: INTEGER;
  89. beg*, end*, delta*: INTEGER (** range: [beg, end); length = length' + delta **)
  90. END;
  91. Directory* = POINTER TO ABSTRACT RECORD
  92. attr-: Attributes
  93. END;
  94. Run = POINTER TO EXTENSIBLE RECORD
  95. prev, next: Run;
  96. len: INTEGER;
  97. attr: Attributes
  98. END;
  99. LPiece = POINTER TO EXTENSIBLE RECORD (Run)
  100. file: Files.File;
  101. org: INTEGER
  102. END;
  103. Piece = POINTER TO RECORD (LPiece) END; (* u IS Piece => CHAR run *)
  104. ViewRef = POINTER TO RECORD (Run) (* u IS ViewRef => View run *)
  105. w, h: INTEGER;
  106. view: Views.View (* embedded view *)
  107. END;
  108. PieceCache = RECORD
  109. org: INTEGER;
  110. prev: Run (* Org(prev.next) = org *)
  111. END;
  112. SpillFile = POINTER TO RECORD
  113. file: Files.File; (* valid if file # NIL *)
  114. len: INTEGER; (* len = file.Length() *)
  115. writer: Files.Writer (* writer.Base() = file *)
  116. END;
  117. AttrDict = RECORD
  118. len: BYTE;
  119. attr: ARRAY dictSize OF Attributes
  120. END;
  121. StdModel = POINTER TO RECORD (Model)
  122. len: INTEGER; (* len = sum(u : [trailer.next, trailer) : u.len) *)
  123. id: INTEGER; (* unique (could use SYSTEM.ADR instead ...) *)
  124. era: INTEGER; (* stable era >= k *)
  125. trailer: Run; (* init => trailer # NIL *)
  126. pc: PieceCache;
  127. spill: SpillFile; (* spill file, created lazily, shared with clones *)
  128. rd: Reader (* reader cache *)
  129. END;
  130. StdContext = POINTER TO RECORD (Context)
  131. text: StdModel;
  132. ref: ViewRef
  133. END;
  134. StdReader = POINTER TO RECORD (Reader)
  135. base: StdModel; (* base = Base() *)
  136. pos: INTEGER; (* pos = Pos() *)
  137. era: INTEGER;
  138. run: Run; (* era = base.era => Pos(run) + off = pos *)
  139. off: INTEGER; (* era = base.era => 0 <= off < run.len *)
  140. reader: Files.Reader (* file reader cache *)
  141. END;
  142. StdWriter = POINTER TO RECORD (Writer)
  143. base: StdModel; (* base = Base() *)
  144. (* hasSequencer := base.Domain() = NIL OR base.Domain().GetSequencer() = NIL *)
  145. pos: INTEGER; (* pos = Pos() *)
  146. era: INTEGER; (* relevant iff hasSequencer *)
  147. run: Run (* hasSequencer & era = base.era => Pos(run) = pos *)
  148. END;
  149. StdDirectory = POINTER TO RECORD (Directory) END;
  150. MoveOp = POINTER TO RECORD (Stores.Operation) (* MoveStretchFrom *)
  151. (* move src.[beg, end) to dest.pos *)
  152. src: StdModel;
  153. beg, end: INTEGER;
  154. dest: StdModel;
  155. pos: INTEGER
  156. END;
  157. EditOp = POINTER TO RECORD (Stores.Operation) (* CopyStretchFrom, Delete, WriteXXX *)
  158. mode: INTEGER;
  159. canBunch: BOOLEAN;
  160. text: StdModel;
  161. beg, end: INTEGER; (* op = deleteRange: move text.[beg, end) to <first, last> *)
  162. pos: INTEGER;
  163. first, last: Run; (* op = moveBuf: move <first, last> to text.pos;
  164. op = writeView: insert <first> at text.pos*)
  165. len: INTEGER; (* op = moveBuf: length of <first, last>;
  166. op = write[L]Char: length of spill file before writing new [long] char *)
  167. attr: Attributes (* op = write[L]Char *)
  168. END;
  169. AttrList = POINTER TO RECORD
  170. next: AttrList;
  171. len: INTEGER;
  172. attr: Attributes
  173. END;
  174. SetAttrOp = POINTER TO RECORD (Stores.Operation) (* SetAttr, Modify *)
  175. text: StdModel;
  176. beg: INTEGER;
  177. list: AttrList
  178. END;
  179. ResizeViewOp = POINTER TO RECORD (Stores.Operation) (* ResizeView *)
  180. text: StdModel;
  181. pos: INTEGER;
  182. ref: ViewRef;
  183. w, h: INTEGER
  184. END;
  185. ReplaceViewOp = POINTER TO RECORD (Stores.Operation) (* ReplaceView *)
  186. text: StdModel;
  187. pos: INTEGER;
  188. ref: ViewRef;
  189. new: Views.View
  190. END;
  191. TextCache = RECORD
  192. id: INTEGER; (* id of the text block served by this cache block *)
  193. beg, end: INTEGER; (* [beg .. end) cached, 0 <= end - beg < cacheLen *)
  194. buf: ARRAY cacheLen OF BYTE (* [beg MOD cacheLen .. end MOD cacheLen) *)
  195. END;
  196. Cache = ARRAY cacheWidth OF TextCache;
  197. VAR
  198. dir-, stdDir-: Directory;
  199. stdProp: Properties.StdProp; (* temp for NewColor, ... NewWeight *)
  200. prop: Prop; (* temp for NewOffset *)
  201. nextId: INTEGER;
  202. cache: Cache;
  203. (** Model **)
  204. PROCEDURE (m: Model) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
  205. VAR thisVersion: INTEGER;
  206. BEGIN
  207. m.Internalize^(rd); IF rd.cancelled THEN RETURN END;
  208. rd.ReadVersion(minVersion, maxModelVersion, thisVersion)
  209. END Internalize;
  210. PROCEDURE (m: Model) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
  211. BEGIN
  212. m.Externalize^(wr);
  213. wr.WriteVersion(maxModelVersion)
  214. END Externalize;
  215. PROCEDURE (m: Model) Length* (): INTEGER, NEW, ABSTRACT;
  216. PROCEDURE (m: Model) NewReader* (old: Reader): Reader, NEW, ABSTRACT;
  217. PROCEDURE (m: Model) NewWriter* (old: Writer): Writer, NEW, ABSTRACT;
  218. PROCEDURE (m: Model) InsertCopy* (pos: INTEGER; m0: Model; beg0, end0: INTEGER), NEW, ABSTRACT;
  219. PROCEDURE (m: Model) Insert* (pos: INTEGER; m0: Model; beg0, end0: INTEGER), NEW, ABSTRACT;
  220. PROCEDURE (m: Model) Delete* (beg, end: INTEGER), NEW, ABSTRACT;
  221. PROCEDURE (m: Model) SetAttr* (beg, end: INTEGER; attr: Attributes), NEW, ABSTRACT;
  222. PROCEDURE (m: Model) Prop* (beg, end: INTEGER): Properties.Property, NEW, ABSTRACT;
  223. PROCEDURE (m: Model) Modify* (beg, end: INTEGER; old, p: Properties.Property), NEW, ABSTRACT;
  224. PROCEDURE (m: Model) ReplaceView* (old, new: Views.View), ABSTRACT;
  225. PROCEDURE (m: Model) Append* (m0: Model), NEW, ABSTRACT;
  226. (*
  227. BEGIN
  228. ASSERT(m # m0, 20);
  229. m.Insert(m.Length(), m0, 0, m0.Length())
  230. END Append;
  231. *)
  232. PROCEDURE (m: Model) Replace* (beg, end: INTEGER; m0: Model; beg0, end0: INTEGER),
  233. NEW, ABSTRACT;
  234. (*
  235. VAR script: Stores.Operation; delta: INTEGER;
  236. BEGIN
  237. Models.BeginScript(m, "#System:Replacing", script);
  238. m.Delete(beg, end);
  239. IF beg0 >
  240. m.Insert(beg, m0, beg0, end0);
  241. Models.EndScript(m, script)
  242. END Replace;
  243. *)
  244. (** Attributes **)
  245. PROCEDURE (a: Attributes) CopyFrom- (source: Stores.Store), EXTENSIBLE;
  246. (** pre: ~a.init, source.init **)
  247. (** post: a.init **)
  248. BEGIN
  249. WITH source: Attributes DO
  250. ASSERT(~a.init, 20); ASSERT(source.init, 21); a.init := TRUE;
  251. a.color := source.color; a.font := source.font; a.offset := source.offset
  252. END
  253. END CopyFrom;
  254. PROCEDURE (a: Attributes) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
  255. (** pre: ~a.init **)
  256. (** post: a.init **)
  257. VAR thisVersion: INTEGER;
  258. fprint: INTEGER; face: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
  259. BEGIN
  260. ASSERT(~a.init, 20); a.init := TRUE;
  261. a.Internalize^(rd);
  262. IF rd.cancelled THEN RETURN END;
  263. rd.ReadVersion(minVersion, maxAttrVersion, thisVersion);
  264. IF rd.cancelled THEN RETURN END;
  265. rd.ReadInt(a.color);
  266. rd.ReadInt(fprint);
  267. rd.ReadXString(face); rd.ReadInt(size); rd.ReadSet(style); rd.ReadXInt(weight);
  268. a.font := Fonts.dir.This(face, size, style, weight);
  269. IF a.font.IsAlien() THEN Stores.Report("#System:AlienFont", face, "", "")
  270. (*
  271. ELSIF a.font.Fingerprint() # fprint THEN Stores.Report("#System:AlienFontVersion", face, "", "")
  272. *)
  273. END;
  274. rd.ReadInt(a.offset)
  275. END Internalize;
  276. PROCEDURE (a: Attributes) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
  277. (** pre: a.init **)
  278. VAR f: Fonts.Font;
  279. BEGIN
  280. ASSERT(a.init, 20);
  281. a.Externalize^(wr);
  282. wr.WriteVersion(maxAttrVersion);
  283. wr.WriteInt(a.color);
  284. f := a.font;
  285. (*
  286. wr.WriteInt(f.Fingerprint());
  287. *)
  288. wr.WriteInt(0);
  289. wr.WriteXString(f.typeface); wr.WriteInt(f.size); wr.WriteSet(f.style); wr.WriteXInt(f.weight);
  290. wr.WriteInt(a.offset)
  291. END Externalize;
  292. PROCEDURE (a: Attributes) InitFromProp* (p: Properties.Property), NEW, EXTENSIBLE;
  293. (** pre: ~a.init **)
  294. (** post: a.init, x IN p.valid => x set in a, else x defaults in a **)
  295. VAR def: Fonts.Font; face: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
  296. BEGIN
  297. ASSERT(~a.init, 20); a.init := TRUE;
  298. def := Fonts.dir.Default();
  299. face := def.typeface$; size := def.size; style := def.style; weight := def.weight;
  300. a.color := Ports.defaultColor; a.offset := 0;
  301. WHILE p # NIL DO
  302. WITH p: Properties.StdProp DO
  303. IF Properties.color IN p.valid THEN a.color := p.color.val END;
  304. IF Properties.typeface IN p.valid THEN face := p.typeface END;
  305. IF (Properties.size IN p.valid)
  306. & (Ports.point <= p.size) & (p.size <= 32767 * Ports.point) THEN
  307. size := p.size
  308. END;
  309. IF Properties.style IN p.valid THEN
  310. style := style - p.style.mask + p.style.val * p.style.mask
  311. END;
  312. IF (Properties.weight IN p.valid) & (1 <= p.weight) & (p.weight <= 1000) THEN
  313. weight := p.weight
  314. END
  315. | p: Prop DO
  316. IF offset IN p.valid THEN a.offset := p.offset END
  317. ELSE
  318. END;
  319. p := p.next
  320. END;
  321. a.font := Fonts.dir.This(face, size, style, weight)
  322. END InitFromProp;
  323. PROCEDURE (a: Attributes) Equals* (b: Attributes): BOOLEAN, NEW, EXTENSIBLE;
  324. (** pre: a.init, b.init **)
  325. BEGIN
  326. ASSERT(a.init, 20); ASSERT((b # NIL) & b.init, 21);
  327. RETURN (a = b)
  328. OR (Services.SameType(a, b))
  329. & (a.color = b.color) & (a.font = b.font) & (a.offset = b.offset)
  330. END Equals;
  331. PROCEDURE (a: Attributes) Prop* (): Properties.Property, NEW, EXTENSIBLE;
  332. (** pre: a.init **)
  333. VAR p: Properties.Property; sp: Properties.StdProp; tp: Prop;
  334. BEGIN
  335. ASSERT(a.init, 20);
  336. NEW(sp);
  337. sp.known := {Properties.color .. Properties.weight}; sp.valid := sp.known;
  338. sp.color.val := a.color;
  339. sp.typeface := a.font.typeface$;
  340. sp.size := a.font.size;
  341. sp.style.mask := {Fonts.italic, Fonts.underline, Fonts.strikeout};
  342. sp.style.val := a.font.style * sp.style.mask;
  343. sp.weight := a.font.weight;
  344. NEW(tp);
  345. tp.known := {offset}; tp.valid := tp.known;
  346. tp.offset := a.offset;
  347. Properties.Insert(p, tp); Properties.Insert(p, sp);
  348. RETURN p
  349. END Prop;
  350. PROCEDURE (a: Attributes) ModifyFromProp- (p: Properties.Property), NEW, EXTENSIBLE;
  351. (** pre: ~a.init **)
  352. VAR face: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
  353. valid: SET;
  354. BEGIN
  355. face := a.font.typeface; size := a.font.size;
  356. style := a.font.style; weight := a.font.weight;
  357. WHILE p # NIL DO
  358. valid := p.valid;
  359. WITH p: Properties.StdProp DO
  360. IF Properties.color IN valid THEN a.color := p.color.val END;
  361. IF Properties.typeface IN valid THEN
  362. face := p.typeface
  363. END;
  364. IF (Properties.size IN valid)
  365. & (Ports.point <= p.size) & (p.size <= 32767 * Ports.point) THEN
  366. size := p.size
  367. ELSE EXCL(valid, Properties.size)
  368. END;
  369. IF Properties.style IN valid THEN
  370. style := style - p.style.mask + p.style.val * p.style.mask
  371. END;
  372. IF (Properties.weight IN valid) & (1 <= p.weight) & (p.weight <= 1000) THEN
  373. weight := p.weight
  374. ELSE EXCL(valid, Properties.weight)
  375. END;
  376. IF valid - {Properties.typeface .. Properties.weight} # valid THEN
  377. a.font := Fonts.dir.This(face, size, style, weight)
  378. END
  379. | p: Prop DO
  380. IF offset IN valid THEN a.offset := p.offset END
  381. ELSE
  382. END;
  383. p := p.next
  384. END
  385. END ModifyFromProp;
  386. PROCEDURE ReadAttr* (VAR rd: Stores.Reader; VAR a: Attributes);
  387. VAR st: Stores.Store; alien: AlienAttributes;
  388. BEGIN
  389. rd.ReadStore(st); ASSERT(st # NIL, 20);
  390. IF st IS Stores.Alien THEN
  391. NEW(alien); alien.store := st(Stores.Alien); Stores.Join(alien, alien.store);
  392. alien.InitFromProp(NIL); a := alien;
  393. Stores.Report("#Text:AlienAttributes", "", "", "")
  394. ELSE a := st(Attributes)
  395. END
  396. END ReadAttr;
  397. PROCEDURE WriteAttr* (VAR wr: Stores.Writer; a: Attributes);
  398. BEGIN
  399. ASSERT(a # NIL, 20); ASSERT(a.init, 21);
  400. WITH a: AlienAttributes DO wr.WriteStore(a.store) ELSE wr.WriteStore(a) END
  401. END WriteAttr;
  402. PROCEDURE ModifiedAttr* (a: Attributes; p: Properties.Property): Attributes;
  403. (** pre: a.init **)
  404. (** post: x IN p.valid => x in new attr set to value in p, else set to value in a **)
  405. VAR h: Attributes;
  406. BEGIN
  407. ASSERT(a.init, 20);
  408. h := Stores.CopyOf(a)(Attributes); h.ModifyFromProp(p);
  409. RETURN h
  410. END ModifiedAttr;
  411. (** AlienAttributes **)
  412. PROCEDURE (a: AlienAttributes) Externalize- (VAR wr: Stores.Writer);
  413. BEGIN
  414. HALT(100)
  415. END Externalize;
  416. PROCEDURE (a: AlienAttributes) CopyFrom- (source: Stores.Store);
  417. BEGIN
  418. a.CopyFrom^(source);
  419. a.store := Stores.CopyOf(source(AlienAttributes).store)(Stores.Alien);
  420. Stores.Join(a, a.store)
  421. END CopyFrom;
  422. PROCEDURE (a: AlienAttributes) Prop* (): Properties.Property;
  423. BEGIN
  424. RETURN NIL
  425. END Prop;
  426. PROCEDURE (a: AlienAttributes) ModifyFromProp- (p: Properties.Property);
  427. END ModifyFromProp;
  428. (** Prop **)
  429. PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
  430. VAR valid: SET;
  431. BEGIN
  432. WITH q: Prop DO
  433. valid := p.valid * q.valid; equal := TRUE;
  434. IF p.offset # q.offset THEN EXCL(valid, offset) END;
  435. IF p.code # q.code THEN EXCL(valid, code) END;
  436. IF p.valid # valid THEN p.valid := valid; equal := FALSE END
  437. END
  438. END IntersectWith;
  439. (** Context **)
  440. PROCEDURE (c: Context) ThisModel* (): Model, ABSTRACT;
  441. PROCEDURE (c: Context) Pos* (): INTEGER, NEW, ABSTRACT;
  442. PROCEDURE (c: Context) Attr* (): Attributes, NEW, ABSTRACT;
  443. (** Reader **)
  444. PROCEDURE (rd: Reader) Base* (): Model, NEW, ABSTRACT;
  445. PROCEDURE (rd: Reader) SetPos* (pos: INTEGER), NEW, ABSTRACT;
  446. PROCEDURE (rd: Reader) Pos* (): INTEGER, NEW, ABSTRACT;
  447. PROCEDURE (rd: Reader) Read*, NEW, ABSTRACT;
  448. PROCEDURE (rd: Reader) ReadPrev*, NEW, ABSTRACT;
  449. PROCEDURE (rd: Reader) ReadChar* (OUT ch: CHAR), NEW, ABSTRACT;
  450. (*
  451. BEGIN
  452. rd.Read; ch := rd.char
  453. END ReadChar;
  454. *)
  455. PROCEDURE (rd: Reader) ReadPrevChar* (OUT ch: CHAR), NEW, ABSTRACT;
  456. (*
  457. BEGIN
  458. rd.ReadPrev; ch := rd.char
  459. END ReadPrevChar;
  460. *)
  461. PROCEDURE (rd: Reader) ReadView* (OUT v: Views.View), NEW, ABSTRACT;
  462. (*
  463. BEGIN
  464. REPEAT rd.Read UNTIL (rd.view # NIL) OR rd.eot;
  465. v := rd.view
  466. END ReadView;
  467. *)
  468. PROCEDURE (rd: Reader) ReadPrevView* (OUT v: Views.View), NEW, ABSTRACT;
  469. (*
  470. BEGIN
  471. REPEAT rd.ReadPrev UNTIL (rd.view # NIL) OR rd.eot;
  472. v := rd.view
  473. END ReadPrevView;
  474. *)
  475. PROCEDURE (rd: Reader) ReadRun* (OUT attr: Attributes), NEW, ABSTRACT;
  476. (** post: rd.eot OR a # NIL, rd.view = ViewAt(rd.Pos() - 1) **)
  477. (*
  478. VAR a: Attributes;
  479. BEGIN
  480. a := rd.attr;
  481. REPEAT rd.Read UNTIL (rd.attr # a) OR (rd.view # NIL) OR rd.eot;
  482. IF rd.eot THEN attr := NIL ELSE attr := rd.attr END
  483. END ReadRun;
  484. *)
  485. PROCEDURE (rd: Reader) ReadPrevRun* (OUT attr: Attributes), NEW, ABSTRACT;
  486. (** post: rd.eot OR a # NIL, rd.view = ViewAt(rd.Pos()) **)
  487. (*
  488. VAR a: Attributes;
  489. BEGIN
  490. a := rd.attr;
  491. REPEAT rd.ReadPrev UNTIL (rd.attr # a) OR (rd.view # NIL) OR rd.eot;
  492. IF rd.eot THEN attr := NIL ELSE attr := rd.attr END
  493. END ReadPrevRun;
  494. *)
  495. (** Writer **)
  496. PROCEDURE (wr: Writer) Base* (): Model, NEW, ABSTRACT;
  497. PROCEDURE (wr: Writer) SetPos* (pos: INTEGER), NEW, ABSTRACT;
  498. PROCEDURE (wr: Writer) Pos* (): INTEGER, NEW, ABSTRACT;
  499. (* PROCEDURE (wr: Writer) WriteSChar* (ch: SHORTCHAR), NEW, ABSTRACT; *)
  500. PROCEDURE (wr: Writer) WriteChar* (ch: CHAR), NEW, ABSTRACT;
  501. PROCEDURE (wr: Writer) WriteView* (view: Views.View; w, h: INTEGER), NEW, ABSTRACT;
  502. PROCEDURE (wr: Writer) SetAttr* (attr: Attributes), NEW(*, EXTENSIBLE*);
  503. BEGIN
  504. ASSERT(attr # NIL, 20); ASSERT(attr.init, 21); wr.attr := attr
  505. END SetAttr;
  506. (** Directory **)
  507. PROCEDURE (d: Directory) New* (): Model, NEW, ABSTRACT;
  508. PROCEDURE (d: Directory) NewFromString* (s: ARRAY OF CHAR): Model, NEW, EXTENSIBLE;
  509. VAR m: Model; w: Writer; i: INTEGER;
  510. BEGIN
  511. m := d.New(); w := m.NewWriter(NIL);
  512. i := 0; WHILE s[i] # 0X DO w.WriteChar(s[i]); INC(i) END;
  513. RETURN m
  514. END NewFromString;
  515. PROCEDURE (d: Directory) SetAttr* (attr: Attributes), NEW, EXTENSIBLE;
  516. BEGIN
  517. ASSERT(attr.init, 20); d.attr := attr
  518. END SetAttr;
  519. (* StdModel - foundation *)
  520. PROCEDURE OpenSpill (s: SpillFile);
  521. BEGIN
  522. s.file := Files.dir.Temp(); s.len := 0;
  523. s.writer := s.file.NewWriter(NIL)
  524. END OpenSpill;
  525. PROCEDURE Find (t: StdModel; VAR pos: INTEGER; VAR u: Run; VAR off: INTEGER);
  526. (* post: 0 <= pos <= t.len, 0 <= off < u.len, Pos(u) + off = pos *)
  527. (* Read/Write rely on Find to force pos into the legal range *)
  528. VAR v: Run; m: INTEGER;
  529. BEGIN
  530. IF pos < 0 THEN pos := 0 END;
  531. IF pos >= t.len THEN
  532. u := t.trailer; off := 0; t.pc.prev := t.trailer; t.pc.org := 0
  533. ELSE
  534. v := t.pc.prev.next; m := pos - t.pc.org;
  535. IF m >= 0 THEN
  536. WHILE m >= v.len DO DEC(m, v.len); v := v.next END
  537. ELSE
  538. WHILE m < 0 DO v := v.prev; INC(m, v.len) END
  539. END;
  540. u := v; off := m; t.pc.prev := v.prev; t.pc.org := pos - m
  541. END
  542. END Find;
  543. PROCEDURE Split (off: INTEGER; VAR u, un: Run);
  544. (* pre: 0 <= off <= u.len *)
  545. (* post: u.len = off, u.len + un.len = u'.len, Pos(u) + u.len = Pos(un) *)
  546. VAR lp: LPiece; sp: Piece;
  547. BEGIN
  548. IF off = 0 THEN un := u; u := un.prev (* "split" at left edge of run *)
  549. ELSIF off < u.len THEN (* u.len > 1 => u IS LPiece; true split *)
  550. WITH u: Piece DO
  551. NEW(sp); sp^ := u^; INC(sp.org, off);
  552. un := sp
  553. ELSE (* u IS LPiece) & ~(u IS Piece) *)
  554. NEW(lp);
  555. lp.prev := u.prev; lp.next := u.next; lp.len := u.len; lp.attr := u.attr;
  556. lp.file := u(LPiece).file; lp.org := u(LPiece).org;
  557. INC(lp.org, 2 * off);
  558. un := lp
  559. END;
  560. DEC(un.len, off); DEC(u.len, un.len);
  561. un.prev := u; un.next := u.next; un.next.prev := un; u.next := un
  562. ELSIF off = u.len THEN un := u.next (* "split" at right edge of run *)
  563. ELSE HALT(100)
  564. END
  565. END Split;
  566. PROCEDURE Merge (t: StdModel; u: Run; VAR v: Run);
  567. VAR p, q: LPiece;
  568. BEGIN
  569. WITH u: Piece DO
  570. IF (v IS Piece) & ((u.attr = v.attr) OR u.attr.Equals(v.attr)) THEN
  571. p := u; q := v(Piece);
  572. IF (p.file = q.file) & (p.org + p.len = q.org) THEN
  573. IF t.pc.prev = p THEN INC(t.pc.org, q.len)
  574. ELSIF t.pc.prev = q THEN t.pc.prev := t.trailer; t.pc.org := 0
  575. END;
  576. INC(p.len, q.len); v := v.next
  577. END
  578. END
  579. | u: LPiece DO (* ~(u IS Piece) *)
  580. IF (v IS LPiece) & ~(v IS Piece) & ((u.attr = v.attr) OR u.attr.Equals(v.attr)) THEN
  581. p := u(LPiece); q := v(LPiece);
  582. IF (p.file = q.file) & (p.org + 2 * p.len = q.org) THEN
  583. IF t.pc.prev = p THEN INC(t.pc.org, q.len)
  584. ELSIF t.pc.prev = q THEN t.pc.prev := t.trailer; t.pc.org := 0
  585. END;
  586. INC(p.len, q.len); v := v.next
  587. END
  588. END
  589. ELSE (* ignore: can't merge ViewRef runs *)
  590. END
  591. END Merge;
  592. PROCEDURE Splice (un, v, w: Run); (* (u, un) -> (u, v ... w, un) *)
  593. VAR u: Run;
  594. BEGIN
  595. IF v # w.next THEN (* non-empty stretch v ... w *)
  596. u := un.prev;
  597. u.next := v; v.prev := u; un.prev := w; w.next := un
  598. END
  599. END Splice;
  600. PROCEDURE NewContext (r: ViewRef; text: StdModel): StdContext;
  601. VAR c: StdContext;
  602. BEGIN
  603. NEW(c); c.text := text; c.ref := r;
  604. Stores.Join(text, r.view);
  605. RETURN c
  606. END NewContext;
  607. PROCEDURE CopyOfPiece (p: LPiece): LPiece;
  608. VAR lp: LPiece; sp: Piece;
  609. BEGIN
  610. WITH p: Piece DO NEW(sp); sp^ := p^; RETURN sp
  611. ELSE
  612. NEW(lp);
  613. lp.prev := p.prev; lp.next := p.next; lp.len := p.len; lp.attr := p.attr;
  614. lp.file := p(LPiece).file; lp.org := p(LPiece).org;
  615. RETURN lp
  616. END
  617. END CopyOfPiece;
  618. PROCEDURE CopyOfViewRef (r: ViewRef; text: StdModel): ViewRef;
  619. VAR v: ViewRef;
  620. BEGIN
  621. NEW(v); v^ := r^;
  622. v.view := Views.CopyOf(r.view, Views.deep);
  623. v.view.InitContext(NewContext(v, text));
  624. RETURN v
  625. END CopyOfViewRef;
  626. PROCEDURE InvalCache (t: StdModel; pos: INTEGER);
  627. VAR n: INTEGER;
  628. BEGIN
  629. n := t.id MOD cacheWidth;
  630. IF cache[n].id = t.id THEN
  631. IF pos <= cache[n].beg THEN cache[n].beg := 0; cache[n].end := 0
  632. ELSIF pos < cache[n].end THEN cache[n].end := pos
  633. END
  634. END
  635. END InvalCache;
  636. PROCEDURE StdInit (t: StdModel);
  637. VAR u: Run;
  638. BEGIN
  639. IF t.trailer = NIL THEN
  640. NEW(u); u.len := MAX(INTEGER); u.attr := NIL; u.next := u; u.prev := u;
  641. t.len := 0; t.id := nextId; INC(nextId); t.era := 0; t.trailer := u;
  642. t.pc.prev := u; t.pc.org := 0;
  643. IF t.spill = NIL THEN NEW(t.spill) END
  644. END
  645. END StdInit;
  646. PROCEDURE CopyOf (src: StdModel; beg, end: INTEGER; dst: StdModel): StdModel;
  647. VAR buf: StdModel; u, v, r, z, zn: Run; ud, vd: INTEGER;
  648. BEGIN
  649. ASSERT(beg < end, 20);
  650. buf := Containers.CloneOf(dst)(StdModel);
  651. ASSERT(buf.Domain() = NIL, 100);
  652. Find(src, beg, u, ud); Find(src, end, v, vd);
  653. z := buf.trailer; r := u;
  654. WHILE r # v DO
  655. WITH r: LPiece DO (* Piece or LPiece *)
  656. zn := CopyOfPiece(r); DEC(zn.len, ud);
  657. IF zn IS Piece THEN INC(zn(LPiece).org, ud) ELSE INC(zn(LPiece).org, 2 * ud) END
  658. | r: ViewRef DO
  659. zn := CopyOfViewRef(r, buf)
  660. ELSE (* ignore *)
  661. END;
  662. z.next := zn; zn.prev := z; z := zn; r := r.next; ud := 0
  663. END;
  664. IF vd > 0 THEN (* v IS LPiece *)
  665. zn := CopyOfPiece(v(LPiece)); zn.len := vd - ud;
  666. IF zn IS Piece THEN INC(zn(LPiece).org, ud) ELSE INC(zn(LPiece).org, 2 * ud) END;
  667. z.next := zn; zn.prev := z; z := zn
  668. END;
  669. z.next := buf.trailer; buf.trailer.prev := z;
  670. buf.len := end - beg;
  671. RETURN buf
  672. END CopyOf;
  673. PROCEDURE ProjectionOf (src: Model; beg, end: INTEGER; dst: StdModel): StdModel;
  674. (* rider-conversion to eliminate covariance conflicts in binary operations *)
  675. VAR buf: StdModel; rd: Reader; wr: Writer;
  676. BEGIN
  677. rd := src.NewReader(NIL); rd.SetPos(beg);
  678. buf := Containers.CloneOf(dst)(StdModel); ASSERT(buf.Domain() = NIL, 100);
  679. wr := buf.NewWriter(NIL);
  680. WHILE beg < end DO
  681. INC(beg);
  682. rd.Read; wr.SetAttr(rd.attr);
  683. IF rd.view # NIL THEN
  684. wr.WriteView(Views.CopyOf(rd.view, Views.deep), rd.w, rd.h)
  685. ELSE
  686. wr.WriteChar(rd.char)
  687. END
  688. END;
  689. RETURN buf
  690. END ProjectionOf;
  691. PROCEDURE Move (src: StdModel; beg, end: INTEGER; dest: StdModel; pos: INTEGER);
  692. VAR pc: PieceCache; view: Views.View;
  693. u, un, v, vn, w, wn: Run; ud, vd, wd: INTEGER;
  694. (*initDom: BOOLEAN; newDom, dom: Stores.Domain;*)
  695. upd: UpdateMsg; neut: Models.NeutralizeMsg;
  696. BEGIN
  697. Models.Broadcast(src, neut);
  698. Find(src, beg, u, ud); Split(ud, u, un); pc := src.pc;
  699. Find(src, end, v, vd); Split(vd, v, vn); src.pc := pc;
  700. Merge(src, u, vn); u.next := vn; vn.prev := u;
  701. DEC(src.len, end - beg);
  702. InvalCache(src, beg);
  703. INC(src.era);
  704. upd.op := delete; upd.beg := beg; upd.end := beg + 1; upd.delta := beg - end;
  705. Models.Broadcast(src, upd);
  706. IF src = dest THEN
  707. IF pos > end THEN DEC(pos, end - beg) END
  708. ELSE
  709. (*newDom := dest.Domain(); initDom := (src.Domain() = NIL) & (newDom # NIL);*)
  710. w := un;
  711. WHILE w # vn DO
  712. (*
  713. IF initDom THEN
  714. dom := w.attr.Domain();
  715. IF (dom # NIL) & (dom # newDom) THEN w.attr := Stores.CopyOf(w.attr)(Attributes) END;
  716. Stores.InitDomain(w.attr, newDom)
  717. END;
  718. *)
  719. IF ~Stores.Joined(dest, w.attr) THEN
  720. IF ~Stores.Unattached(w.attr) THEN w.attr := Stores.CopyOf(w.attr)(Attributes) END;
  721. Stores.Join(dest, w.attr)
  722. END;
  723. WITH w: ViewRef DO
  724. view := w.view;
  725. (*IF initDom THEN Stores.InitDomain(view, newDom) END;*)
  726. Stores.Join(dest, view);
  727. view.context(StdContext).text := dest
  728. ELSE
  729. END;
  730. w := w.next
  731. END
  732. END;
  733. Find(dest, pos, w, wd); Split(wd, w, wn); Splice(wn, un, v);
  734. v := wn.prev; Merge(dest, v, wn); v.next := wn; wn.prev := v;
  735. wn := w.next; Merge(dest, w, wn); w.next := wn; wn.prev := w;
  736. INC(dest.len, end - beg);
  737. InvalCache(dest, pos);
  738. INC(dest.era);
  739. upd.op := insert; upd.beg := pos; upd.end := pos + end - beg; upd.delta := end - beg;
  740. Models.Broadcast(dest, upd)
  741. END Move;
  742. (* StdModel - operations *)
  743. PROCEDURE (op: MoveOp) Do;
  744. VAR src, dest: StdModel; beg, end, pos: INTEGER; neut: Models.NeutralizeMsg;
  745. BEGIN
  746. src := op.src; beg := op.beg; end := op.end; dest := op.dest; pos := op.pos;
  747. IF src = dest THEN
  748. IF pos < beg THEN
  749. op.pos := end; op.beg := pos; op.end := pos + end - beg
  750. ELSE
  751. op.pos := beg; op.beg := pos - (end - beg); op.end := pos
  752. END
  753. ELSE
  754. Models.Broadcast(op.src, neut); (* destination is neutralized by sequencer *)
  755. op.dest := src; op.src := dest;
  756. op.pos := beg; op.beg := pos; op.end := pos + end - beg
  757. END;
  758. Move(src, beg, end, dest, pos)
  759. END Do;
  760. PROCEDURE DoMove (name: Stores.OpName;
  761. src: StdModel; beg, end: INTEGER;
  762. dest: StdModel; pos: INTEGER
  763. );
  764. VAR op: MoveOp;
  765. BEGIN
  766. IF (beg < end) & ((src # dest) OR ~((beg <= pos) & (pos <= end))) THEN
  767. NEW(op);
  768. op.src := src; op.beg := beg; op.end := end;
  769. op.dest := dest; op.pos := pos;
  770. Models.Do(dest, name, op)
  771. END
  772. END DoMove;
  773. PROCEDURE (op: EditOp) Do;
  774. VAR text: StdModel; (*newDom, dom: Stores.Domain;*) pc: PieceCache;
  775. u, un, v, vn: Run; sp: Piece; lp: LPiece; r: ViewRef;
  776. ud, vd, beg, end, pos, len: INTEGER; w, h: INTEGER;
  777. upd: UpdateMsg;
  778. BEGIN
  779. text := op.text;
  780. CASE op.mode OF
  781. deleteRange:
  782. beg := op.beg; end := op.end; len := end - beg;
  783. Find(text, beg, u, ud); Split(ud, u, un); pc := text.pc;
  784. Find(text, end, v, vd); Split(vd, v, vn); text.pc := pc;
  785. Merge(text, u, vn); u.next := vn; vn.prev := u;
  786. DEC(text.len, len);
  787. InvalCache(text, beg);
  788. INC(text.era);
  789. op.mode := moveBuf; op.canBunch := FALSE;
  790. op.pos := beg; op.first := un; op.last := v; op.len := len;
  791. upd.op := delete; upd.beg := beg; upd.end := beg + 1; upd.delta := -len;
  792. Models.Broadcast(text, upd)
  793. | moveBuf:
  794. pos := op.pos;
  795. Find(text, pos, u, ud); Split(ud, u, un); Splice(un, op.first, op.last);
  796. INC(text.len, op.len);
  797. InvalCache(text, pos);
  798. INC(text.era);
  799. op.mode := deleteRange;
  800. op.beg := pos; op.end := pos + op.len;
  801. upd.op := insert; upd.beg := pos; upd.end := pos + op.len; upd.delta := op.len;
  802. Models.Broadcast(text, upd)
  803. | writeSChar:
  804. pos := op.pos;
  805. InvalCache(text, pos);
  806. Find(text, pos, u, ud); Split(ud, u, un);
  807. IF (u.attr = op.attr) & (u IS Piece) & (u(Piece).file = text.spill.file)
  808. & (u(Piece).org + u.len = op.len) THEN
  809. INC(u.len);
  810. IF text.pc.org >= pos THEN INC(text.pc.org) END
  811. ELSE
  812. (*
  813. newDom := text.Domain();
  814. IF newDom # NIL THEN
  815. dom := op.attr.Domain();
  816. IF (dom # NIL) & (dom # newDom) THEN
  817. op.attr := Stores.CopyOf(op.attr)(Attributes)
  818. END;
  819. Stores.InitDomain(op.attr, newDom)
  820. END;
  821. *)
  822. IF ~Stores.Joined(text, op.attr) THEN
  823. IF ~Stores.Unattached(op.attr) THEN op.attr := Stores.CopyOf(op.attr)(Attributes) END;
  824. Stores.Join(text, op.attr)
  825. END;
  826. NEW(sp); u.next := sp; sp.prev := u; sp.next := un; un.prev := sp;
  827. sp.len := 1; sp.attr := op.attr;
  828. sp.file := text.spill.file; sp.org := op.len;
  829. IF text.pc.org > pos THEN INC(text.pc.org) END
  830. END;
  831. INC(text.len); INC(text.era);
  832. op.mode := deleteRange;
  833. upd.op := insert; upd.beg := pos; upd.end := pos + 1; upd.delta := 1;
  834. Models.Broadcast(text, upd)
  835. | writeChar:
  836. pos := op.pos;
  837. InvalCache(text, pos);
  838. Find(text, pos, u, ud); Split(ud, u, un);
  839. IF (u.attr = op.attr) & (u IS LPiece) & ~(u IS Piece) & (u(LPiece).file = text.spill.file)
  840. & (u(LPiece).org + 2 * u.len = op.len) THEN
  841. INC(u.len);
  842. IF text.pc.org >= pos THEN INC(text.pc.org) END
  843. ELSE
  844. (*
  845. newDom := text.Domain();
  846. IF newDom # NIL THEN
  847. dom := op.attr.Domain();
  848. IF (dom # NIL) & (dom # newDom) THEN
  849. op.attr := Stores.CopyOf(op.attr)(Attributes)
  850. END;
  851. Stores.InitDomain(op.attr, newDom)
  852. END;
  853. *)
  854. IF ~Stores.Joined(text, op.attr) THEN
  855. IF ~Stores.Unattached(op.attr) THEN op.attr := Stores.CopyOf(op.attr)(Attributes) END;
  856. Stores.Join(text, op.attr)
  857. END;
  858. NEW(lp); u.next := lp; lp.prev := u; lp.next := un; un.prev := lp;
  859. lp.len := 1; lp.attr := op.attr;
  860. lp.file := text.spill.file; lp.org := op.len;
  861. IF text.pc.org > pos THEN INC(text.pc.org) END
  862. END;
  863. INC(text.len); INC(text.era);
  864. op.mode := deleteRange;
  865. upd.op := insert; upd.beg := pos; upd.end := pos + 1; upd.delta := 1;
  866. Models.Broadcast(text, upd)
  867. | writeView:
  868. pos := op.pos; r := op.first(ViewRef);
  869. InvalCache(text, pos);
  870. Find(text, pos, u, ud); Split(ud, u, un);
  871. u.next := r; r.prev := u; r.next := un; un.prev := r;
  872. INC(text.len); INC(text.era);
  873. r.view.InitContext(NewContext(r, text));
  874. (* Stores.InitDomain(r.view, text.Domain()); *)
  875. Stores.Join(text, r.view);
  876. w := r.w; h := r.h; r.w := defW; r.h := defH;
  877. Properties.PreferredSize(r.view, minWidth, maxWidth, minHeight, maxHeight, defW, defH,
  878. w, h
  879. );
  880. r.w := w; r.h := h;
  881. op.mode := deleteRange;
  882. upd.op := insert; upd.beg := pos; upd.end := pos + 1; upd.delta := 1;
  883. Models.Broadcast(text, upd)
  884. END
  885. END Do;
  886. PROCEDURE GetWriteOp (t: StdModel; pos: INTEGER; VAR op: EditOp; VAR bunch: BOOLEAN);
  887. VAR last: Stores.Operation;
  888. BEGIN
  889. last := Models.LastOp(t);
  890. IF (last # NIL) & (last IS EditOp) THEN
  891. op := last(EditOp);
  892. bunch := op.canBunch & (op.end = pos)
  893. ELSE bunch := FALSE
  894. END;
  895. IF bunch THEN
  896. INC(op.end)
  897. ELSE
  898. NEW(op); op.canBunch := TRUE;
  899. op.text := t; op.beg := pos; op.end := pos + 1
  900. END;
  901. op.pos := pos
  902. END GetWriteOp;
  903. PROCEDURE SetPreferredSize (t: StdModel; v: Views.View);
  904. VAR minW, maxW, minH, maxH, w, h: INTEGER;
  905. BEGIN
  906. t.GetEmbeddingLimits(minW, maxW, minH, maxH);
  907. v.context.GetSize(w, h);
  908. Properties.PreferredSize(v, minW, maxW, minH, maxH, w, h, w, h);
  909. v.context.SetSize(w, h)
  910. END SetPreferredSize;
  911. PROCEDURE (op: SetAttrOp) Do;
  912. VAR t: StdModel; attr: Attributes; z: AttrList; (*checkDom: BOOLEAN;*)
  913. pc: PieceCache; u, un, v, vn: Run; ud, vd, pos, next: INTEGER;
  914. upd: UpdateMsg;
  915. BEGIN
  916. t := op.text; z := op.list; pos := op.beg; (*checkDom := t.Domain() # NIL;*)
  917. WHILE z # NIL DO
  918. next := pos + z.len;
  919. IF z.attr # NIL THEN
  920. Find(t, pos, u, ud); Split(ud, u, un); pc := t.pc;
  921. Find(t, next, v, vd); Split(vd, v, vn); t.pc := pc;
  922. attr := un.attr;
  923. WHILE un # vn DO
  924. un.attr := z.attr;
  925. (*
  926. IF checkDom & (un.attr.Domain() # t.Domain()) THEN
  927. IF un.attr.Domain() # NIL THEN un.attr := Stores.CopyOf(un.attr)(Attributes) END;
  928. Stores.InitDomain(un.attr, t.Domain())
  929. END;
  930. *)
  931. IF ~Stores.Joined(t, un.attr) THEN
  932. IF ~Stores.Unattached(un.attr) THEN un.attr := Stores.CopyOf(un.attr)(Attributes) END;
  933. Stores.Join(t, un.attr)
  934. END;
  935. Merge(t, u, un);
  936. WITH un: ViewRef DO SetPreferredSize(t, un.view) ELSE END;
  937. IF u.next = un THEN u := un; un := un.next ELSE u.next := un; un.prev := u END
  938. END;
  939. Merge(t, u, un); u.next := un; un.prev := u;
  940. z.attr := attr
  941. END;
  942. pos := next; z := z.next
  943. END;
  944. INC(t.era);
  945. upd.op := replace; upd.beg := op.beg; upd.end := pos; upd.delta := 0;
  946. Models.Broadcast(t, upd)
  947. END Do;
  948. PROCEDURE (op: ResizeViewOp) Do;
  949. VAR r: ViewRef; w, h: INTEGER; upd: UpdateMsg;
  950. BEGIN
  951. r := op.ref;
  952. w := op.w; h := op.h; op.w := r.w; op.h := r.h; r.w := w; r.h := h;
  953. INC(op.text.era);
  954. upd.op := replace; upd.beg := op.pos; upd.end := op.pos + 1; upd.delta := 0;
  955. Models.Broadcast(op.text, upd)
  956. END Do;
  957. PROCEDURE (op: ReplaceViewOp) Do;
  958. VAR new: Views.View; upd: UpdateMsg;
  959. BEGIN
  960. new := op.new; op.new := op.ref.view; op.ref.view := new;
  961. INC(op.text.era);
  962. upd.op := replace; upd.beg := op.pos; upd.end := op.pos + 1; upd.delta := 0;
  963. Models.Broadcast(op.text, upd)
  964. END Do;
  965. (* StdModel *)
  966. PROCEDURE (t: StdModel) InitFrom (source: Containers.Model);
  967. BEGIN
  968. WITH source: StdModel DO
  969. ASSERT(source.trailer # NIL, 20);
  970. t.spill := source.spill; (* reduce no of temp files: share spill files among clones *)
  971. StdInit(t)
  972. END
  973. END InitFrom;
  974. PROCEDURE WriteCharacters (t: StdModel; VAR wr: Stores.Writer);
  975. VAR r: Files.Reader; u: Run; len: INTEGER;
  976. (*
  977. sp: Properties.StorePref;
  978. *)
  979. buf: ARRAY 1024 OF BYTE;
  980. BEGIN
  981. r := NIL;
  982. u := t.trailer.next;
  983. WHILE u # t.trailer DO
  984. WITH u: Piece DO
  985. r := u.file.NewReader(r); r.SetPos(u.org);
  986. len := u.len;
  987. WHILE len > LEN(buf) DO
  988. r.ReadBytes(buf, 0, LEN(buf)); wr.rider.WriteBytes(buf, 0, LEN(buf));
  989. DEC(len, LEN(buf))
  990. END;
  991. r.ReadBytes(buf, 0, len); wr.rider.WriteBytes(buf, 0, len)
  992. | u: LPiece DO (* ~(u IS Piece) *)
  993. r := u.file.NewReader(r); r.SetPos(u.org);
  994. len := 2 * u.len;
  995. WHILE len > LEN(buf) DO
  996. r.ReadBytes(buf, 0, LEN(buf)); wr.rider.WriteBytes(buf, 0, LEN(buf));
  997. DEC(len, LEN(buf))
  998. END;
  999. r.ReadBytes(buf, 0, len); wr.rider.WriteBytes(buf, 0, len)
  1000. | u: ViewRef DO
  1001. (*
  1002. sp.view := u.view; Views.HandlePropMsg(u.view, sp);
  1003. IF sp.view # NIL THEN wr.WriteSChar(viewcode) END
  1004. *)
  1005. IF Stores.ExternalizeProxy(u.view) # NIL THEN
  1006. wr.WriteSChar(viewcode)
  1007. END
  1008. END;
  1009. u := u.next
  1010. END
  1011. END WriteCharacters;
  1012. PROCEDURE WriteAttributes (VAR wr: Stores.Writer; t: StdModel;
  1013. a: Attributes; VAR dict: AttrDict
  1014. );
  1015. VAR k, len: BYTE;
  1016. BEGIN
  1017. len := dict.len; k := 0; WHILE (k # len) & ~a.Equals(dict.attr[k]) DO INC(k) END;
  1018. wr.WriteByte(k);
  1019. IF k = len THEN
  1020. IF len < dictSize THEN dict.attr[len] := a; INC(dict.len) END;
  1021. (* ASSERT(Stores.Joined(t, a)); but bkwd-comp: *)
  1022. (* IF a.Domain() # d THEN always copy: bkwd-comp hack to avoid link *)
  1023. a := Stores.CopyOf(a)(Attributes); (* Stores.InitDomain(a, d); *) Stores.Join(t, a);
  1024. (* END; *)
  1025. WriteAttr(wr, a)
  1026. END
  1027. END WriteAttributes;
  1028. PROCEDURE (t: StdModel) Externalize (VAR wr: Stores.Writer);
  1029. VAR (*dom: Stores.Domain;*) u, v, un: Run;
  1030. attr: Attributes; dict: AttrDict;
  1031. org, runlen, pos: INTEGER; lchars: BOOLEAN;
  1032. inf: InfoMsg;
  1033. BEGIN
  1034. t.Externalize^(wr);
  1035. StdInit(t); (*dom := t.Domain();*)
  1036. wr.WriteVersion(0);
  1037. wr.WriteInt(0); org := wr.Pos();
  1038. u := t.trailer.next; v := t.trailer; dict.len := 0; lchars := FALSE;
  1039. WHILE u # v DO
  1040. attr := u.attr;
  1041. WITH u: Piece DO
  1042. runlen := u.len; un := u.next;
  1043. WHILE (un IS Piece) & un.attr.Equals(attr) DO
  1044. INC(runlen, un.len); un := un.next
  1045. END;
  1046. WriteAttributes(wr, t, attr, dict); wr.WriteInt(runlen)
  1047. | u: LPiece DO (* ~(u IS Piece) *)
  1048. runlen := 2 * u.len; un := u.next;
  1049. WHILE (un IS LPiece) & ~(un IS Piece) & un.attr.Equals(attr) DO
  1050. INC(runlen, 2 * un.len); un := un.next
  1051. END;
  1052. WriteAttributes(wr, t, attr, dict); wr.WriteInt(-runlen);
  1053. lchars := TRUE
  1054. | u: ViewRef DO
  1055. IF Stores.ExternalizeProxy(u.view) # NIL THEN
  1056. WriteAttributes(wr, t, attr, dict); wr.WriteInt(0);
  1057. wr.WriteInt(u.w); wr.WriteInt(u.h); Views.WriteView(wr, u.view)
  1058. END;
  1059. un := u.next
  1060. END;
  1061. u := un
  1062. END;
  1063. wr.WriteByte(-1);
  1064. pos := wr.Pos();
  1065. wr.SetPos(org - 5);
  1066. IF lchars THEN wr.WriteVersion(maxStdModelVersion)
  1067. ELSE wr.WriteVersion(noLCharStdModelVersion) (* version 0 did not support LONGCHAR *)
  1068. END;
  1069. wr.WriteInt(pos - org);
  1070. wr.SetPos(pos);
  1071. WriteCharacters(t, wr);
  1072. inf.op := store; Models.Broadcast(t, inf)
  1073. END Externalize;
  1074. PROCEDURE (t: StdModel) Internalize (VAR rd: Stores.Reader);
  1075. VAR u, un: Run; sp: Piece; lp: LPiece; v: ViewRef;
  1076. org, len: INTEGER; ano: BYTE; thisVersion: INTEGER;
  1077. attr: Attributes; dict: AttrDict;
  1078. BEGIN
  1079. ASSERT(t.Domain() = NIL, 20); ASSERT(t.len = 0, 21);
  1080. t.Internalize^(rd); IF rd.cancelled THEN RETURN END;
  1081. rd.ReadVersion(minVersion, maxStdModelVersion, thisVersion);
  1082. IF rd.cancelled THEN RETURN END;
  1083. StdInit(t);
  1084. dict.len := 0; u := t.trailer;
  1085. rd.ReadInt(len); org := rd.Pos() + len;
  1086. rd.ReadByte(ano);
  1087. WHILE ano # -1 DO
  1088. IF ano = dict.len THEN
  1089. ReadAttr(rd, attr); Stores.Join(t, attr);
  1090. IF dict.len < dictSize THEN dict.attr[dict.len] := attr; INC(dict.len) END
  1091. ELSE
  1092. attr := dict.attr[ano]
  1093. END;
  1094. rd.ReadInt(len);
  1095. IF len > 0 THEN (* piece *)
  1096. NEW(sp); sp.len := len; sp.attr := attr;
  1097. sp.file := rd.rider.Base(); sp.org := org; un := sp;
  1098. INC(org, len)
  1099. ELSIF len < 0 THEN (* longchar piece *)
  1100. len := -len; ASSERT(~ODD(len), 100);
  1101. NEW(lp); lp.len := len DIV 2; lp.attr := attr;
  1102. lp.file := rd.rider.Base(); lp.org := org; un := lp;
  1103. INC(org, len)
  1104. ELSE (* len = 0 => embedded view *)
  1105. NEW(v); v.len := 1; v.attr := attr;
  1106. rd.ReadInt(v.w); rd.ReadInt(v.h); Views.ReadView(rd, v.view);
  1107. v.view.InitContext(NewContext(v, t));
  1108. un := v; INC(org)
  1109. END;
  1110. INC(t.len, un.len); u.next := un; un.prev := u; u := un;
  1111. rd.ReadByte(ano)
  1112. END;
  1113. rd.SetPos(org);
  1114. u.next := t.trailer; t.trailer.prev := u
  1115. END Internalize;
  1116. (*
  1117. PROCEDURE (t: StdModel) PropagateDomain;
  1118. VAR u: Run; dom: Stores.Domain;
  1119. BEGIN
  1120. IF t.Domain() # NIL THEN
  1121. u := t.trailer.next;
  1122. WHILE u # t.trailer DO
  1123. dom := u.attr.Domain();
  1124. IF (dom # NIL) & (dom # t.Domain()) THEN u.attr := Stores.CopyOf(u.attr)(Attributes) END;
  1125. Stores.InitDomain(u.attr, t.Domain());
  1126. WITH u: ViewRef DO Stores.InitDomain(u.view, t.Domain()) ELSE END;
  1127. u := u.next
  1128. END
  1129. END
  1130. END PropagateDomain;
  1131. *)
  1132. PROCEDURE (t: StdModel) GetEmbeddingLimits (OUT minW, maxW, minH, maxH: INTEGER);
  1133. BEGIN
  1134. minW := minWidth; maxW := maxWidth; minH := minHeight; maxH := maxHeight
  1135. END GetEmbeddingLimits;
  1136. PROCEDURE (t: StdModel) Length (): INTEGER;
  1137. BEGIN
  1138. StdInit(t);
  1139. RETURN t.len
  1140. END Length;
  1141. PROCEDURE (t: StdModel) NewReader (old: Reader): Reader;
  1142. VAR rd: StdReader;
  1143. BEGIN
  1144. StdInit(t);
  1145. IF (old # NIL) & (old IS StdReader) THEN rd := old(StdReader) ELSE NEW(rd) END;
  1146. IF rd.base # t THEN
  1147. rd.base := t; rd.era := -1; rd.SetPos(0)
  1148. ELSIF rd.pos > t.len THEN
  1149. rd.SetPos(t.len)
  1150. END;
  1151. rd.eot := FALSE;
  1152. RETURN rd
  1153. END NewReader;
  1154. PROCEDURE (t: StdModel) NewWriter (old: Writer): Writer;
  1155. VAR wr: StdWriter;
  1156. BEGIN
  1157. StdInit(t);
  1158. IF (old # NIL) & (old IS StdWriter) THEN wr := old(StdWriter) ELSE NEW(wr) END;
  1159. IF (wr.base # t) OR (wr.pos > t.len) THEN
  1160. wr.base := t; wr.era := -1; wr.SetPos(t.len)
  1161. END;
  1162. wr.SetAttr(dir.attr);
  1163. RETURN wr
  1164. END NewWriter;
  1165. PROCEDURE (t: StdModel) InsertCopy (pos: INTEGER; t0: Model; beg0, end0: INTEGER);
  1166. VAR buf: StdModel;
  1167. BEGIN
  1168. StdInit(t);
  1169. ASSERT(0 <= pos, 21); ASSERT(pos <= t.len, 22);
  1170. ASSERT(0 <= beg0, 23); ASSERT(beg0 <= end0, 24); ASSERT(end0 <= t0.Length(), 25);
  1171. IF beg0 < end0 THEN
  1172. WITH t0: StdModel DO buf := CopyOf(t0, beg0, end0, t)
  1173. ELSE buf := ProjectionOf(t0, beg0, end0, t)
  1174. END;
  1175. (* IF t.Domain() # NIL THEN Stores.InitDomain(buf,t.Domain()) END; *)
  1176. Stores.Join(t, buf);
  1177. DoMove("#System:Copying", buf, 0, buf.len, t, pos)
  1178. END
  1179. END InsertCopy;
  1180. PROCEDURE (t: StdModel) Insert (pos: INTEGER; t0: Model; beg, end: INTEGER);
  1181. BEGIN
  1182. StdInit(t);
  1183. ASSERT(0 <= pos, 21); ASSERT(pos <= t.len, 22);
  1184. ASSERT(0 <= beg, 23); ASSERT(beg <= end, 24); ASSERT(end <= t0.Length(), 25);
  1185. IF beg < end THEN
  1186. IF (t.Domain() # NIL) & (t0 IS StdModel) & (t0.Domain() = t.Domain()) THEN
  1187. DoMove("#System:Moving", t0(StdModel), beg, end, t, pos)
  1188. ELSE (* moving across domains *)
  1189. t.InsertCopy(pos, t0, beg, end); t0.Delete(beg, end)
  1190. END
  1191. END
  1192. END Insert;
  1193. PROCEDURE (t: StdModel) Append (t0: Model);
  1194. VAR len0: INTEGER;
  1195. BEGIN
  1196. StdInit(t);
  1197. ASSERT(t # t0, 20);
  1198. len0 := t0.Length();
  1199. IF len0 > 0 THEN
  1200. IF (t.Domain() # NIL) & (t0 IS StdModel) & (t0.Domain() = t.Domain()) THEN
  1201. DoMove("#Text:Appending", t0(StdModel), 0, len0, t, t.len)
  1202. ELSE (* moving across domains *)
  1203. t.InsertCopy(t.len, t0, 0, len0); t0.Delete(0, len0)
  1204. END
  1205. END
  1206. END Append;
  1207. PROCEDURE (t: StdModel) Delete (beg, end: INTEGER);
  1208. VAR op: EditOp;
  1209. BEGIN
  1210. StdInit(t);
  1211. ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
  1212. IF beg < end THEN
  1213. NEW(op); op.mode := deleteRange; op.canBunch := FALSE;
  1214. op.text := t; op.beg := beg; op.end := end;
  1215. Models.Do(t, "#System:Deleting", op)
  1216. END
  1217. END Delete;
  1218. PROCEDURE (t: StdModel) SetAttr (beg, end: INTEGER; attr: Attributes);
  1219. VAR op: SetAttrOp; zp, z: AttrList;
  1220. u, v, w: Run; ud, vd: INTEGER; modified: BOOLEAN;
  1221. BEGIN
  1222. StdInit(t);
  1223. ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
  1224. IF beg < end THEN
  1225. NEW(op); op.text := t; op.beg := beg;
  1226. Find(t, beg, u, ud); Find(t, end, v, vd);
  1227. IF vd > 0 THEN w := v.next ELSE w := v END;
  1228. zp := NIL; modified := FALSE;
  1229. WHILE u # w DO
  1230. IF u = v THEN INC(ud, v.len - vd) END;
  1231. NEW(z); z.len := u.len - ud; z.attr := attr;
  1232. IF zp = NIL THEN op.list := z ELSE zp.next:= z END;
  1233. zp := z;
  1234. modified := modified OR ~u.attr.Equals(attr);
  1235. u := u.next; ud := 0
  1236. END;
  1237. IF modified THEN Models.Do(t, "#Text:AttributeChange", op) END
  1238. END
  1239. END SetAttr;
  1240. PROCEDURE (t: StdModel) Prop (beg, end: INTEGER): Properties.Property;
  1241. VAR p, q: Properties.Property; tp: Prop;
  1242. u, v, w: Run; ud, vd: INTEGER; equal: BOOLEAN;
  1243. rd: Reader;
  1244. BEGIN
  1245. StdInit(t);
  1246. ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
  1247. IF beg < end THEN
  1248. Find(t, beg, u, ud); Find(t, end, v, vd);
  1249. IF vd > 0 THEN w := v.next ELSE w := v END;
  1250. p := u.attr.Prop();
  1251. u := u.next;
  1252. WHILE u # w DO
  1253. Properties.Intersect(p, u.attr.Prop(), equal);
  1254. u := u.next
  1255. END;
  1256. IF beg + 1 = end THEN
  1257. t.rd := t.NewReader(t.rd); rd := t.rd;
  1258. rd.SetPos(beg); rd.Read;
  1259. IF (rd.view = NIL) OR (rd.char # viewcode) THEN
  1260. q := p; WHILE (q # NIL) & ~(q IS Prop) DO q := q.next END;
  1261. IF q # NIL THEN
  1262. tp := q(Prop)
  1263. ELSE NEW(tp); Properties.Insert(p, tp)
  1264. END;
  1265. INCL(tp.valid, code); INCL(tp.known, code); INCL(tp.readOnly, code);
  1266. tp.code := rd.char
  1267. END
  1268. END
  1269. ELSE p := NIL
  1270. END;
  1271. RETURN p
  1272. END Prop;
  1273. PROCEDURE (t: StdModel) Modify (beg, end: INTEGER; old, p: Properties.Property);
  1274. VAR op: SetAttrOp; zp, z: AttrList;
  1275. u, v, w: Run; ud, vd: INTEGER; equal, modified: BOOLEAN;
  1276. q: Properties.Property;
  1277. BEGIN
  1278. StdInit(t);
  1279. ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
  1280. IF (beg < end) & (p # NIL) THEN
  1281. NEW(op); op.text := t; op.beg := beg;
  1282. Find(t, beg, u, ud); Find(t, end, v, vd);
  1283. IF vd > 0 THEN w := v.next ELSE w := v END;
  1284. zp := NIL; modified := FALSE;
  1285. WHILE u # w DO
  1286. IF u = v THEN INC(ud, v.len - vd) END;
  1287. IF old # NIL THEN
  1288. q := u.attr.Prop();
  1289. Properties.Intersect(q, old, equal); (* q := q * old *)
  1290. Properties.Intersect(q, old, equal) (* equal := q = old *)
  1291. END;
  1292. NEW(z); z.len := u.len - ud;
  1293. IF (old = NIL) OR equal THEN
  1294. z.attr := ModifiedAttr(u.attr, p);
  1295. modified := modified OR ~u.attr.Equals(z.attr)
  1296. END;
  1297. IF zp = NIL THEN op.list := z ELSE zp.next := z END;
  1298. zp := z;
  1299. u := u.next; ud := 0
  1300. END;
  1301. IF modified THEN Models.Do(t, "#System:Modifying", op) END
  1302. END
  1303. END Modify;
  1304. PROCEDURE (t: StdModel) ReplaceView (old, new: Views.View);
  1305. VAR c: StdContext; op: ReplaceViewOp;
  1306. BEGIN
  1307. StdInit(t);
  1308. ASSERT(old.context # NIL, 20); ASSERT(old.context IS StdContext, 21);
  1309. ASSERT(old.context(StdContext).text = t, 22);
  1310. ASSERT((new.context = NIL) OR (new.context = old.context), 24);
  1311. IF new # old THEN
  1312. c := old.context(StdContext);
  1313. IF new.context = NIL THEN new.InitContext(c) END;
  1314. (* Stores.InitDomain(new, t.Domain()); *)
  1315. Stores.Join(t, new);
  1316. NEW(op); op.text := t; op.pos := c.Pos(); op.ref := c.ref; op.new := new;
  1317. Models.Do(t, "#System:Replacing", op)
  1318. END
  1319. END ReplaceView;
  1320. PROCEDURE (t: StdModel) CopyFrom- (source: Stores.Store);
  1321. BEGIN
  1322. StdInit(t);
  1323. WITH source: StdModel DO t.InsertCopy(0, source, 0, source.len) END
  1324. END CopyFrom;
  1325. PROCEDURE (t: StdModel) Replace (beg, end: INTEGER; t0: Model; beg0, end0: INTEGER);
  1326. VAR script: Stores.Operation;
  1327. BEGIN
  1328. StdInit(t);
  1329. ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
  1330. ASSERT(0 <= beg0, 23); ASSERT(beg0 <= end0, 24); ASSERT(end0 <= t0.Length(), 25);
  1331. ASSERT(t # t0, 26);
  1332. Models.BeginScript(t, "#System:Replacing", script);
  1333. t.Delete(beg, end); t.Insert(beg, t0, beg0, end0);
  1334. Models.EndScript(t, script)
  1335. END Replace;
  1336. (* StdContext *)
  1337. PROCEDURE (c: StdContext) ThisModel (): Model;
  1338. BEGIN
  1339. RETURN c.text
  1340. END ThisModel;
  1341. PROCEDURE (c: StdContext) GetSize (OUT w, h: INTEGER);
  1342. BEGIN
  1343. w := c.ref.w; h := c.ref.h
  1344. END GetSize;
  1345. PROCEDURE (c: StdContext) SetSize (w, h: INTEGER);
  1346. VAR t: StdModel; r: ViewRef; op: ResizeViewOp;
  1347. BEGIN
  1348. t := c.text; r := c.ref;
  1349. IF w = Views.undefined THEN w := r.w END;
  1350. IF h = Views.undefined THEN h := r.h END;
  1351. Properties.PreferredSize(r.view, minWidth, maxWidth, minHeight, maxHeight, r.w, r.h, w, h);
  1352. IF (w # r.w) OR (h # r.h) THEN
  1353. NEW(op); op.text := t; op.pos := c.Pos(); op.ref := r; op.w := w; op.h := h;
  1354. Models.Do(t, "#System:Resizing", op)
  1355. END
  1356. END SetSize;
  1357. PROCEDURE (c: StdContext) Normalize (): BOOLEAN;
  1358. BEGIN
  1359. RETURN FALSE
  1360. END Normalize;
  1361. PROCEDURE (c: StdContext) Pos (): INTEGER;
  1362. VAR t: StdModel; u, r, w: Run; pos: INTEGER;
  1363. BEGIN
  1364. t := c.text; r := c.ref;
  1365. IF t.pc.prev.next # r THEN
  1366. u := t.trailer.next; w := t.trailer; pos := 0;
  1367. WHILE (u # r) & (u # w) DO INC(pos, u.len); u := u.next END;
  1368. ASSERT(u = r, 20);
  1369. t.pc.prev := r.prev; t.pc.org := pos
  1370. END;
  1371. RETURN t.pc.org
  1372. END Pos;
  1373. PROCEDURE (c: StdContext) Attr (): Attributes;
  1374. BEGIN
  1375. RETURN c.ref.attr
  1376. END Attr;
  1377. (* StdReader *)
  1378. PROCEDURE RemapView (rd: StdReader);
  1379. VAR p: Pref;
  1380. BEGIN
  1381. p.opts := {}; Views.HandlePropMsg(rd.view, p);
  1382. IF maskChar IN p.opts THEN rd.char := p.mask ELSE rd.char := viewcode END
  1383. END RemapView;
  1384. PROCEDURE Reset (rd: StdReader);
  1385. VAR t: StdModel;
  1386. BEGIN
  1387. t := rd.base;
  1388. Find(t, rd.pos, rd.run, rd.off); rd.era := t.era
  1389. END Reset;
  1390. PROCEDURE (rd: StdReader) Base (): Model;
  1391. BEGIN
  1392. RETURN rd.base
  1393. END Base;
  1394. PROCEDURE (rd: StdReader) SetPos (pos: INTEGER);
  1395. BEGIN
  1396. ASSERT(pos >= 0, 20); ASSERT(rd.base # NIL, 21); ASSERT(pos <= rd.base.len, 22);
  1397. rd.eot := FALSE; rd.attr := NIL; rd.char := 0X; rd.view := NIL;
  1398. IF (rd.pos # pos) OR (rd.run = rd.base.trailer) THEN
  1399. rd.pos := pos; rd.era := -1
  1400. END
  1401. END SetPos;
  1402. PROCEDURE (rd: StdReader) Pos (): INTEGER;
  1403. BEGIN
  1404. RETURN rd.pos
  1405. END Pos;
  1406. PROCEDURE (rd: StdReader) Read;
  1407. VAR t: StdModel; u: Run; n, pos, len: INTEGER; lc: ARRAY 2 OF BYTE;
  1408. BEGIN
  1409. t := rd.base;
  1410. n := t.id MOD cacheWidth;
  1411. IF rd.era # t.era THEN Reset(rd) END;
  1412. u := rd.run;
  1413. WITH u: Piece DO
  1414. rd.attr := u.attr;
  1415. pos := rd.pos MOD cacheLen;
  1416. IF ~((cache[n].id = t.id) & (cache[n].beg <= rd.pos) & (rd.pos < cache[n].end)) THEN
  1417. (* cache miss *)
  1418. IF cache[n].id # t.id THEN cache[n].id := t.id; cache[n].beg := 0; cache[n].end := 0 END;
  1419. len := cacheLine;
  1420. IF len > cacheLen - pos THEN len := cacheLen - pos END;
  1421. IF len > u.len - rd.off THEN len := u.len - rd.off END;
  1422. rd.reader := u.file.NewReader(rd.reader); rd.reader.SetPos(u.org + rd.off);
  1423. rd.reader.ReadBytes(cache[n].buf, pos, len);
  1424. IF rd.pos = cache[n].end THEN
  1425. cache[n].end := rd.pos + len;
  1426. (*
  1427. INC(cache[n].end, len);
  1428. *)
  1429. IF cache[n].end - cache[n].beg >= cacheLen THEN
  1430. cache[n].beg := cache[n].end - (cacheLen - 1)
  1431. END
  1432. ELSE cache[n].beg := rd.pos; cache[n].end := rd.pos + len
  1433. END
  1434. END;
  1435. rd.char := CHR(cache[n].buf[pos] MOD 256); rd.view := NIL;
  1436. INC(rd.pos); INC(rd.off);
  1437. IF rd.off = u.len THEN rd.run := u.next; rd.off := 0 END
  1438. | u: LPiece DO (* ~(u IS Piece) *)
  1439. rd.attr := u.attr;
  1440. rd.reader := u.file.NewReader(rd.reader); rd.reader.SetPos(u.org + rd.off * 2);
  1441. rd.reader.ReadBytes(lc, 0, 2);
  1442. rd.char := CHR(lc[0] MOD 256 + 256 * (lc[1] + 128)); rd.view := NIL;
  1443. IF (cache[n].id = t.id) & (rd.pos = cache[n].end) THEN
  1444. cache[n].end := cache[n].end + 1;
  1445. IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].beg := cache[n].beg + 1 END;
  1446. (*
  1447. INC(cache[n].end);
  1448. IF cache[n].end - cache[n].beg >= cacheLen THEN INC(cache[n].beg) END
  1449. *)
  1450. END;
  1451. INC(rd.pos); INC(rd.off);
  1452. IF rd.off = u.len THEN rd.run := u.next; rd.off := 0 END
  1453. | u: ViewRef DO
  1454. rd.attr := u.attr;
  1455. rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd);
  1456. IF (cache[n].id = t.id) & (rd.pos = cache[n].end) THEN
  1457. cache[n].end := cache[n].end + 1;
  1458. IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].beg := cache[n].beg + 1 END;
  1459. (*
  1460. INC(cache[n].end);
  1461. IF cache[n].end - cache[n].beg >= cacheLen THEN INC(cache[n].beg) END
  1462. *)
  1463. END;
  1464. INC(rd.pos); rd.run := u.next; rd.off := 0
  1465. ELSE
  1466. rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
  1467. END
  1468. END Read;
  1469. PROCEDURE (rd: StdReader) ReadPrev;
  1470. VAR t: StdModel; u: Run; n, pos, len: INTEGER; lc: ARRAY 2 OF BYTE;
  1471. BEGIN
  1472. t := rd.base;
  1473. n := t.id MOD cacheWidth;
  1474. IF rd.era # t.era THEN Reset(rd) END;
  1475. IF rd.off > 0 THEN DEC(rd.off)
  1476. ELSIF rd.pos > 0 THEN
  1477. rd.run := rd.run.prev; rd.off := rd.run.len - 1
  1478. ELSE rd.run := t.trailer
  1479. END;
  1480. u := rd.run;
  1481. WITH u: Piece DO
  1482. rd.attr := u.attr;
  1483. DEC(rd.pos);
  1484. pos := rd.pos MOD cacheLen;
  1485. IF ~((cache[n].id = t.id) & (cache[n].beg <= rd.pos) & (rd.pos < cache[n].end)) THEN
  1486. (* cache miss *)
  1487. IF cache[n].id # t.id THEN cache[n].id := t.id; cache[n].beg := 0; cache[n].end := 0 END;
  1488. len := cacheLine;
  1489. IF len > pos + 1 THEN len := pos + 1 END;
  1490. IF len > rd.off + 1 THEN len := rd.off + 1 END;
  1491. rd.reader := u.file.NewReader(rd.reader);
  1492. rd.reader.SetPos(u.org + rd.off - (len - 1));
  1493. rd.reader.ReadBytes(cache[n].buf, pos - (len - 1), len);
  1494. IF rd.pos = cache[n].beg - 1 THEN
  1495. cache[n].beg := cache[n] .beg - len;
  1496. (*
  1497. DEC(cache[n].beg, len);
  1498. *)
  1499. IF cache[n].end - cache[n].beg >= cacheLen THEN
  1500. cache[n].end := cache[n].beg + (cacheLen - 1)
  1501. END
  1502. ELSE cache[n].beg := rd.pos - (len - 1); cache[n].end := rd.pos + 1
  1503. END
  1504. END;
  1505. rd.char := CHR(cache[n].buf[pos] MOD 256); rd.view := NIL
  1506. | u: LPiece DO (* ~(u IS Piece) *)
  1507. rd.attr := u.attr;
  1508. rd.reader := u.file.NewReader(rd.reader);
  1509. rd.reader.SetPos(u.org + 2 * rd.off);
  1510. rd.reader.ReadBytes(lc, 0, 2);
  1511. rd.char := CHR(lc[0] MOD 256 + 256 * (lc[1] + 128)); rd.view := NIL;
  1512. IF (cache[n].id = t.id) & (rd.pos = cache[n].beg) THEN
  1513. cache[n].beg := cache[n].beg - 1;
  1514. IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].end := cache[n].end - 1 END
  1515. (*
  1516. DEC(cache[n].beg);
  1517. IF cache[n].end - cache[n].beg >= cacheLen THEN DEC(cache[n].end) END
  1518. *)
  1519. END;
  1520. DEC(rd.pos)
  1521. | u: ViewRef DO
  1522. rd.attr := u.attr;
  1523. rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd);
  1524. IF (cache[n].id = t.id) & (rd.pos = cache[n].beg) THEN
  1525. cache[n].beg := cache[n].beg - 1;
  1526. IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].end := cache[n].end - 1 END
  1527. (*
  1528. DEC(cache[n].beg);
  1529. IF cache[n].end - cache[n].beg >= cacheLen THEN DEC(cache[n].end) END
  1530. *)
  1531. END;
  1532. DEC(rd.pos)
  1533. ELSE
  1534. rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
  1535. END
  1536. END ReadPrev;
  1537. PROCEDURE (rd: StdReader) ReadChar (OUT ch: CHAR);
  1538. BEGIN
  1539. rd.Read; ch := rd.char
  1540. END ReadChar;
  1541. PROCEDURE (rd: StdReader) ReadPrevChar (OUT ch: CHAR);
  1542. BEGIN
  1543. rd.ReadPrev; ch := rd.char
  1544. END ReadPrevChar;
  1545. PROCEDURE (rd: StdReader) ReadView (OUT v: Views.View);
  1546. VAR t: StdModel; u: Run;
  1547. BEGIN
  1548. t := rd.base;
  1549. IF rd.era # t.era THEN Reset(rd) END;
  1550. DEC(rd.pos, rd.off);
  1551. u := rd.run;
  1552. WHILE u IS LPiece DO INC(rd.pos, u.len); u := u.next END;
  1553. WITH u: ViewRef DO
  1554. INC(rd.pos); rd.run := u.next; rd.off := 0;
  1555. rd.attr := u.attr; rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd)
  1556. ELSE (* u = t.trailer *)
  1557. ASSERT(u = t.trailer, 100);
  1558. rd.run := u; rd.off := 0;
  1559. rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
  1560. END;
  1561. v := rd.view
  1562. END ReadView;
  1563. PROCEDURE (rd: StdReader) ReadPrevView (OUT v: Views.View);
  1564. VAR t: StdModel; u: Run;
  1565. BEGIN
  1566. t := rd.base;
  1567. IF rd.era # t.era THEN Reset(rd) END;
  1568. DEC(rd.pos, rd.off);
  1569. u := rd.run.prev;
  1570. WHILE u IS LPiece DO DEC(rd.pos, u.len); u := u.prev END;
  1571. rd.run := u; rd.off := 0;
  1572. WITH u: ViewRef DO
  1573. DEC(rd.pos);
  1574. rd.attr := u.attr; rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd)
  1575. ELSE (* u = t.trailer *)
  1576. ASSERT(u = t.trailer, 100);
  1577. rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
  1578. END;
  1579. v := rd.view
  1580. END ReadPrevView;
  1581. PROCEDURE (rd: StdReader) ReadRun (OUT attr: Attributes);
  1582. VAR t: StdModel; a0: Attributes; u, trailer: Run; pos: INTEGER;
  1583. BEGIN
  1584. t := rd.base;
  1585. IF rd.era # t.era THEN Reset(rd) END;
  1586. a0 := rd.attr; u := rd.run; pos := rd.pos - rd.off; trailer := t.trailer;
  1587. WHILE (u.attr = a0) & ~(u IS ViewRef) & (u # trailer) DO
  1588. INC(pos, u.len); u := u.next
  1589. END;
  1590. rd.run := u; rd.pos := pos; rd.off := 0;
  1591. rd.Read;
  1592. attr := rd.attr
  1593. END ReadRun;
  1594. PROCEDURE (rd: StdReader) ReadPrevRun (OUT attr: Attributes);
  1595. VAR t: StdModel; a0: Attributes; u, trailer: Run; pos: INTEGER;
  1596. BEGIN
  1597. t := rd.base;
  1598. IF rd.era # t.era THEN Reset(rd) END;
  1599. a0 := rd.attr; u := rd.run; pos := rd.pos - rd.off; trailer := t.trailer;
  1600. IF u # trailer THEN u := u.prev; DEC(pos, u.len) END;
  1601. WHILE (u.attr = a0) & ~(u IS ViewRef) & (u # trailer) DO
  1602. u := u.prev; DEC(pos, u.len)
  1603. END;
  1604. IF u # trailer THEN
  1605. rd.run := u.next; rd.pos := pos + u.len; rd.off := 0
  1606. ELSE
  1607. rd.run := trailer; rd.pos := 0; rd.off := 0
  1608. END;
  1609. rd.ReadPrev;
  1610. attr := rd.attr
  1611. END ReadPrevRun;
  1612. (* StdWriter *)
  1613. PROCEDURE WriterReset (wr: StdWriter);
  1614. VAR t: StdModel; u: Run; uo: INTEGER;
  1615. BEGIN
  1616. t := wr.base;
  1617. Find(t, wr.pos, u, uo); Split(uo, u, wr.run); wr.era := t.era
  1618. END WriterReset;
  1619. PROCEDURE (wr: StdWriter) Base (): Model;
  1620. BEGIN
  1621. RETURN wr.base
  1622. END Base;
  1623. PROCEDURE (wr: StdWriter) SetPos (pos: INTEGER);
  1624. BEGIN
  1625. ASSERT(pos >= 0, 20); ASSERT(wr.base # NIL, 21); ASSERT(pos <= wr.base.len, 22);
  1626. IF wr.pos # pos THEN
  1627. wr.pos := pos; wr.era := -1
  1628. END
  1629. END SetPos;
  1630. PROCEDURE (wr: StdWriter) Pos (): INTEGER;
  1631. BEGIN
  1632. RETURN wr.pos
  1633. END Pos;
  1634. PROCEDURE WriteSChar (wr: StdWriter; ch: SHORTCHAR);
  1635. VAR t: StdModel; u, un: Run; p: Piece; pos, spillPos: INTEGER;
  1636. op: EditOp; bunch: BOOLEAN;
  1637. BEGIN
  1638. t := wr.base; pos := wr.pos;
  1639. IF t.spill.file = NIL THEN OpenSpill(t.spill) END;
  1640. t.spill.writer.WriteByte(SHORT(ORD(ch))); spillPos := t.spill.len; t.spill.len := spillPos + 1;
  1641. IF (t.Domain() = NIL) OR (t.Domain().GetSequencer() = NIL) THEN
  1642. (* optimized for speed - writing to unbound text *)
  1643. InvalCache(t, pos);
  1644. IF wr.era # t.era THEN WriterReset(wr) END;
  1645. un := wr.run; u := un.prev;
  1646. IF (u.attr # NIL) & u.attr.Equals(wr.attr) & (u IS Piece) & (u(Piece).file = t.spill.file)
  1647. & (u(Piece).org + u.len = spillPos) THEN
  1648. INC(u.len);
  1649. IF t.pc.org >= pos THEN INC(t.pc.org) END
  1650. ELSE
  1651. NEW(p); u.next := p; p.prev := u; p.next := un; un.prev := p;
  1652. p.len := 1; p.attr := wr.attr;
  1653. p.file := t.spill.file; p.org := spillPos;
  1654. IF t.pc.org > pos THEN INC(t.pc.org) END;
  1655. IF ~Stores.Joined(t, p.attr) THEN
  1656. IF ~Stores.Unattached(p.attr) THEN p.attr := Stores.CopyOf(p.attr)(Attributes) END;
  1657. Stores.Join(t, p.attr)
  1658. END
  1659. END;
  1660. INC(t.era); INC(t.len);
  1661. INC(wr.era)
  1662. ELSE
  1663. GetWriteOp(t, pos, op, bunch);
  1664. IF (op.attr = NIL) OR ~op.attr.Equals(wr.attr) THEN op.attr := wr.attr END;
  1665. op.mode := writeSChar; (*op.attr := wr.attr;*) op.len := spillPos;
  1666. IF bunch THEN Models.Bunch(t) ELSE Models.Do(t, "#System:Inserting", op) END
  1667. END;
  1668. wr.pos := pos + 1
  1669. END WriteSChar;
  1670. PROCEDURE (wr: StdWriter) WriteChar (ch: CHAR);
  1671. VAR t: StdModel; u, un: Run; lp: LPiece; pos, spillPos: INTEGER;
  1672. fw: Files.Writer; op: EditOp; bunch: BOOLEAN;
  1673. BEGIN
  1674. IF (ch >= 20X) & (ch < 7FX)
  1675. OR (ch = tab) OR (ch = line) OR (ch = para)
  1676. OR (ch = zwspace) OR (ch = digitspace)
  1677. OR (ch = hyphen) OR (ch = nbhyphen) OR (ch >= 0A0X) & (ch < 100X) THEN
  1678. WriteSChar(wr, SHORT(ch)) (* could inline! *)
  1679. ELSIF ch = 200BX THEN wr.WriteChar(zwspace)
  1680. ELSIF ch = 2010X THEN wr.WriteChar(hyphen)
  1681. ELSIF ch = 2011X THEN wr.WriteChar(nbhyphen)
  1682. ELSIF ch >= 100X THEN
  1683. t := wr.base; pos := wr.pos;
  1684. IF t.spill.file = NIL THEN OpenSpill(t.spill) END;
  1685. fw := t.spill.writer;
  1686. fw.WriteByte(SHORT(SHORT(ORD(ch))));
  1687. fw.WriteByte(SHORT(SHORT(ORD(ch) DIV 256 - 128)));
  1688. spillPos := t.spill.len; t.spill.len := spillPos + 2;
  1689. IF (t.Domain() = NIL) OR (t.Domain().GetSequencer() = NIL) THEN
  1690. (* optimized for speed - writing to unbound text *)
  1691. InvalCache(t, pos);
  1692. IF wr.era # t.era THEN WriterReset(wr) END;
  1693. un := wr.run; u := un.prev;
  1694. IF (u.attr # NIL) & u.attr.Equals(wr.attr) & (u IS LPiece) & ~(u IS Piece) & (u(LPiece).file = t.spill.file)
  1695. & (u(LPiece).org + 2 * u.len = spillPos) THEN
  1696. INC(u.len);
  1697. IF t.pc.org >= pos THEN INC(t.pc.org) END
  1698. ELSE
  1699. NEW(lp); u.next := lp; lp.prev := u; lp.next := un; un.prev := lp;
  1700. lp.len := 1; lp.attr := wr.attr;
  1701. lp.file := t.spill.file; lp.org := spillPos;
  1702. IF t.pc.org > pos THEN INC(t.pc.org) END;
  1703. IF ~Stores.Joined(t, lp.attr) THEN
  1704. IF ~Stores.Unattached(lp.attr) THEN lp.attr := Stores.CopyOf(lp.attr)(Attributes) END;
  1705. Stores.Join(t, lp.attr)
  1706. END
  1707. END;
  1708. INC(t.era); INC(t.len);
  1709. INC(wr.era)
  1710. ELSE
  1711. GetWriteOp(t, pos, op, bunch);
  1712. IF (op.attr = NIL) OR ~op.attr.Equals(wr.attr) THEN op.attr := wr.attr END;
  1713. op.mode := writeChar; (*op.attr := wr.attr;*) op.len := spillPos;
  1714. IF bunch THEN Models.Bunch(t) ELSE Models.Do(t, "#System:Inserting", op) END
  1715. END;
  1716. wr.pos := pos + 1
  1717. END
  1718. END WriteChar;
  1719. PROCEDURE (wr: StdWriter) WriteView (view: Views.View; w, h: INTEGER);
  1720. VAR t: StdModel; u, un: Run; r: ViewRef; pos: INTEGER;
  1721. op: EditOp; bunch: BOOLEAN;
  1722. BEGIN
  1723. ASSERT(view # NIL, 20); ASSERT(view.context = NIL, 21);
  1724. t := wr.base; pos := wr.pos;
  1725. Stores.Join(t, view);
  1726. IF (t.Domain() = NIL) OR (t.Domain().GetSequencer() = NIL) THEN
  1727. (* optimized for speed - writing to unbound text *)
  1728. IF wr.era # t.era THEN WriterReset(wr) END;
  1729. InvalCache(t, pos);
  1730. NEW(r); r.len := 1; r.attr := wr.attr; r.view := view; r.w := defW; r.h := defH;
  1731. un := wr.run; u := un.prev; u.next := r; r.prev := u; r.next := un; un.prev := r;
  1732. IF t.pc.org > pos THEN INC(t.pc.org) END;
  1733. INC(t.era); INC(t.len);
  1734. view.InitContext(NewContext(r, t));
  1735. Properties.PreferredSize(view, minWidth, maxWidth, minHeight, maxHeight, defW, defH,
  1736. w, h
  1737. );
  1738. r.w := w; r.h := h;
  1739. INC(wr.era)
  1740. ELSE
  1741. NEW(r); r.len := 1; r.attr := wr.attr; r.view := view; r.w := w; r.h := h;
  1742. GetWriteOp(t, pos, op, bunch);
  1743. op.mode := writeView; op.first := r;
  1744. IF bunch THEN Models.Bunch(t) ELSE Models.Do(t, "#System:Inserting", op) END
  1745. END;
  1746. INC(wr.pos)
  1747. END WriteView;
  1748. (* StdDirectory *)
  1749. PROCEDURE (d: StdDirectory) New (): Model;
  1750. VAR t: StdModel;
  1751. BEGIN
  1752. NEW(t); StdInit(t); RETURN t
  1753. END New;
  1754. (** miscellaneous procedures **)
  1755. (*
  1756. PROCEDURE DumpRuns* (t: Model);
  1757. VAR u: Run; n, i, beg, end: INTEGER; name: ARRAY 64 OF CHAR; r: Files.Reader; b: BYTE;
  1758. BEGIN
  1759. Sub.synch := FALSE;
  1760. WITH t: StdModel DO
  1761. u := t.trailer.next;
  1762. REPEAT
  1763. WITH u: Piece DO
  1764. Sub.String("short");
  1765. Sub.Int(u.len);
  1766. Sub.Char(" "); Sub.IntForm(SYSTEM.ADR(u.file^), 16, 8, "0", FALSE);
  1767. Sub.Int(u.org); Sub.Char(" ");
  1768. r := u.file.NewReader(NIL); r.SetPos(u.org); i := 0;
  1769. WHILE i < 16 DO r.ReadByte(b); Sub.Char(CHR(b)); INC(i) END;
  1770. Sub.Ln
  1771. | u: LPiece DO (* ~(u IS Piece) *)
  1772. Sub.String("long");
  1773. Sub.Int(-u.len);
  1774. Sub.Char(" "); Sub.IntForm(SYSTEM.ADR(u.file^), 16, 8, "0", FALSE);
  1775. Sub.Int(u.org); Sub.Char(" ");
  1776. r := u.file.NewReader(NIL); r.SetPos(u.org); i := 0;
  1777. WHILE i < 16 DO r.ReadByte(b); Sub.Char(CHR(b)); INC(i) END;
  1778. Sub.Ln
  1779. | u: ViewRef DO
  1780. Sub.String("view");
  1781. Services.GetTypeName(u.view, name);
  1782. Sub.String(name); Sub.Int(u.w); Sub.Int(u.h); Sub.Ln
  1783. ELSE
  1784. Sub.Char("?"); Sub.Ln
  1785. END;
  1786. u := u.next
  1787. UNTIL u = t.trailer;
  1788. n := t.id MOD cacheWidth;
  1789. IF cache[n].id = t.id THEN
  1790. beg := cache[n].beg; end := cache[n].end;
  1791. Sub.Int(beg); Sub.Int(end); Sub.Ln;
  1792. Sub.Char("{");
  1793. WHILE beg < end DO Sub.Char(CHR(cache[n].buf[beg MOD cacheLen])); INC(beg) END;
  1794. Sub.Char("}"); Sub.Ln
  1795. ELSE Sub.String("not cached"); Sub.Ln
  1796. END
  1797. END
  1798. END DumpRuns;
  1799. *)
  1800. PROCEDURE NewColor* (a: Attributes; color: Ports.Color): Attributes;
  1801. BEGIN
  1802. ASSERT(a # NIL, 20); ASSERT(a.init, 21);
  1803. stdProp.valid := {Properties.color}; stdProp.color.val := color;
  1804. RETURN ModifiedAttr(a, stdProp)
  1805. END NewColor;
  1806. PROCEDURE NewFont* (a: Attributes; font: Fonts.Font): Attributes;
  1807. BEGIN
  1808. ASSERT(a # NIL, 20); ASSERT(a.init, 21);
  1809. stdProp.valid := {Properties.typeface .. Properties.weight};
  1810. stdProp.typeface := font.typeface$;
  1811. stdProp.size := font.size;
  1812. stdProp.style.val := font.style;
  1813. stdProp.style.mask := {Fonts.italic, Fonts.underline, Fonts.strikeout};
  1814. stdProp.weight := font.weight;
  1815. RETURN ModifiedAttr(a, stdProp)
  1816. END NewFont;
  1817. PROCEDURE NewOffset* (a: Attributes; offset: INTEGER): Attributes;
  1818. BEGIN
  1819. ASSERT(a # NIL, 20); ASSERT(a.init, 21);
  1820. prop.valid := {0 (*global constant offset masked by param :-( *)}; prop.offset := offset;
  1821. RETURN ModifiedAttr(a, prop)
  1822. END NewOffset;
  1823. PROCEDURE NewTypeface* (a: Attributes; typeface: Fonts.Typeface): Attributes;
  1824. BEGIN
  1825. ASSERT(a # NIL, 20); ASSERT(a.init, 21);
  1826. stdProp.valid := {Properties.typeface}; stdProp.typeface := typeface;
  1827. RETURN ModifiedAttr(a, stdProp)
  1828. END NewTypeface;
  1829. PROCEDURE NewSize* (a: Attributes; size: INTEGER): Attributes;
  1830. BEGIN
  1831. ASSERT(a # NIL, 20); ASSERT(a.init, 21);
  1832. stdProp.valid := {Properties.size}; stdProp.size := size;
  1833. RETURN ModifiedAttr(a, stdProp)
  1834. END NewSize;
  1835. PROCEDURE NewStyle* (a: Attributes; style: SET): Attributes;
  1836. BEGIN
  1837. ASSERT(a # NIL, 20); ASSERT(a.init, 21);
  1838. stdProp.valid := {Properties.style}; stdProp.style.val := style; stdProp.style.mask := -{};
  1839. RETURN ModifiedAttr(a, stdProp)
  1840. END NewStyle;
  1841. PROCEDURE NewWeight* (a: Attributes; weight: INTEGER): Attributes;
  1842. BEGIN
  1843. ASSERT(a # NIL, 20); ASSERT(a.init, 21);
  1844. stdProp.valid := {Properties.weight}; stdProp.weight := weight;
  1845. RETURN ModifiedAttr(a, stdProp)
  1846. END NewWeight;
  1847. PROCEDURE WriteableChar* (ch: CHAR): BOOLEAN;
  1848. (* must be identical to test in (StdWriter)WriteChar - inlined there for efficiency *)
  1849. BEGIN
  1850. RETURN
  1851. (ch >= 20X) & (ch < 7FX) OR
  1852. (ch = tab) OR (ch = line) OR (ch = para) OR
  1853. (ch = zwspace) OR (ch = digitspace) OR
  1854. (ch = hyphen) OR (ch = nbhyphen) OR
  1855. (ch >= 0A0X) (* need to augment with test for valid Unicode *)
  1856. END WriteableChar;
  1857. PROCEDURE CloneOf* (source: Model): Model;
  1858. BEGIN
  1859. ASSERT(source # NIL, 20);
  1860. RETURN Containers.CloneOf(source)(Model)
  1861. END CloneOf;
  1862. PROCEDURE SetDir* (d: Directory);
  1863. BEGIN
  1864. ASSERT(d # NIL, 20); ASSERT(d.attr # NIL, 21); ASSERT(d.attr.init, 22);
  1865. dir := d
  1866. END SetDir;
  1867. PROCEDURE Init;
  1868. VAR d: StdDirectory; a: Attributes;
  1869. BEGIN
  1870. NEW(a); a.InitFromProp(NIL);
  1871. NEW(stdProp); stdProp.known := -{};
  1872. NEW(prop); prop.known := -{};
  1873. NEW(d); stdDir := d; dir := d; d.SetAttr(a)
  1874. END Init;
  1875. BEGIN
  1876. Init
  1877. END TextModels.