2
0

Documents.txt 38 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286
  1. MODULE Documents;
  2. (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Documents.odc *)
  3. (* DO NOT EDIT *)
  4. IMPORT
  5. Kernel, Files, Ports, Dates, Printers,
  6. Stores, Sequencers, Models, Views, Controllers, Properties,
  7. Dialog, Printing, Containers;
  8. CONST
  9. (** Document.SetPage/PollPage decorate **)
  10. plain* = FALSE; decorate* = TRUE;
  11. (** Controller.opts **)
  12. pageWidth* = 16; pageHeight* = 17; winWidth* = 18; winHeight* = 19;
  13. point = Ports.point;
  14. mm = Ports.mm;
  15. defB = 8 * point; (* defB also used by HostWindows in DefBorders *)
  16. scrollUnit = 16 * point;
  17. abort = 1;
  18. resizingKey = "#System:Resizing";
  19. pageSetupKey = "#System:PageSetup";
  20. docTag = 6F4F4443H; docVersion = 0;
  21. minVersion = 0; maxModelVersion = 0; maxCtrlVersion = 0;
  22. maxDocVersion = 0; maxStdDocVersion = 0;
  23. TYPE
  24. Document* = POINTER TO ABSTRACT RECORD (Containers.View) END;
  25. Context* = POINTER TO ABSTRACT RECORD (Models.Context) END;
  26. Directory* = POINTER TO ABSTRACT RECORD END;
  27. Model = POINTER TO RECORD (Containers.Model)
  28. doc: StdDocument;
  29. view: Views.View;
  30. l, t, r, b: INTEGER (* possibly r, b >= Views.infinite *)
  31. (* l, t: constant (= defB) *)
  32. (* r-l, b-t: invalid in some cases, use PollRect *)
  33. END;
  34. Controller = POINTER TO RECORD (Containers.Controller)
  35. doc: StdDocument
  36. END;
  37. StdDocument = POINTER TO RECORD (Document)
  38. model: Model;
  39. original: StdDocument; (* original # NIL => d IS copy of original *)
  40. pw, ph, pl, pt, pr, pb: INTEGER; (* invalid if original # NIL, use PollPage *)
  41. decorate: BOOLEAN;
  42. x, y: INTEGER (* scroll state *)
  43. END;
  44. StdContext = POINTER TO RECORD (Context)
  45. model: Model
  46. END;
  47. StdDirectory = POINTER TO RECORD (Directory) END;
  48. SetRectOp = POINTER TO RECORD (Stores.Operation)
  49. model: Model;
  50. w, h: INTEGER
  51. END;
  52. SetPageOp = POINTER TO RECORD (Stores.Operation)
  53. d: StdDocument;
  54. pw, ph, pl, pt, pr, pb: INTEGER;
  55. decorate: BOOLEAN
  56. END;
  57. ReplaceViewOp = POINTER TO RECORD (Stores.Operation)
  58. model: Model;
  59. new: Views.View
  60. END;
  61. PrinterContext = POINTER TO RECORD (Models.Context)
  62. param: Printing.Par;
  63. date: Dates.Date;
  64. time: Dates.Time;
  65. pr: Printers.Printer;
  66. l, t, r, b: INTEGER; (* frame *)
  67. pw, ph: INTEGER (* paper *)
  68. END;
  69. UpdateMsg = RECORD (Views.Message)
  70. doc: StdDocument
  71. END;
  72. PContext = POINTER TO RECORD (Models.Context)
  73. view: Views.View;
  74. w, h: INTEGER (* content size *)
  75. END;
  76. Pager = POINTER TO RECORD (Views.View)
  77. con: PContext;
  78. w, h: INTEGER; (* page size *)
  79. x, y: INTEGER (* origin *)
  80. END;
  81. PrintingHook = POINTER TO RECORD (Printing.Hook) END;
  82. TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
  83. VAR
  84. dir-, stdDir-: Directory;
  85. cleaner: TrapCleaner;
  86. current: INTEGER;
  87. (** Cleaner **)
  88. PROCEDURE (c: TrapCleaner) Cleanup;
  89. BEGIN
  90. Printing.par := NIL; current := -1
  91. END Cleanup;
  92. (** Document **)
  93. PROCEDURE (d: Document) Internalize2- (VAR rd: Stores.Reader), EXTENSIBLE;
  94. VAR thisVersion: INTEGER;
  95. BEGIN
  96. IF rd.cancelled THEN RETURN END;
  97. rd.ReadVersion(minVersion, maxDocVersion, thisVersion)
  98. END Internalize2;
  99. PROCEDURE (d: Document) Externalize2- (VAR wr: Stores.Writer), EXTENSIBLE;
  100. BEGIN
  101. wr.WriteVersion(maxDocVersion)
  102. END Externalize2;
  103. PROCEDURE (d: Document) GetNewFrame* (VAR frame: Views.Frame);
  104. VAR f: Views.RootFrame;
  105. BEGIN
  106. NEW(f); frame := f
  107. END GetNewFrame;
  108. PROCEDURE (d: Document) GetBackground* (VAR color: Ports.Color);
  109. BEGIN
  110. color := Ports.background
  111. END GetBackground;
  112. PROCEDURE (d: Document) DocCopyOf* (v: Views.View): Document, NEW, ABSTRACT;
  113. PROCEDURE (d: Document) SetView* (view: Views.View; w, h: INTEGER), NEW, ABSTRACT;
  114. PROCEDURE (d: Document) ThisView* (): Views.View, NEW, ABSTRACT;
  115. PROCEDURE (d: Document) OriginalView* (): Views.View, NEW, ABSTRACT;
  116. PROCEDURE (d: Document) SetRect* (l, t, r, b: INTEGER), NEW, ABSTRACT;
  117. PROCEDURE (d: Document) PollRect* (VAR l, t, r, b: INTEGER), NEW, ABSTRACT;
  118. PROCEDURE (d: Document) SetPage* (w, h, l, t, r, b: INTEGER; decorate: BOOLEAN), NEW, ABSTRACT;
  119. PROCEDURE (d: Document) PollPage* (VAR w, h, l, t, r, b: INTEGER;
  120. VAR decorate: BOOLEAN), NEW, ABSTRACT;
  121. (** Context **)
  122. PROCEDURE (c: Context) ThisDoc* (): Document, NEW, ABSTRACT;
  123. (** Directory **)
  124. PROCEDURE (d: Directory) New* (view: Views.View; w, h: INTEGER): Document, NEW, ABSTRACT;
  125. (* operations *)
  126. PROCEDURE (op: SetRectOp) Do;
  127. VAR m: Model; w, h: INTEGER; upd: UpdateMsg;
  128. BEGIN
  129. m := op.model;
  130. w := m.r - m.l; h := m.b - m.t;
  131. m.r := m.l + op.w; m.b := m.t + op.h;
  132. op.w := w; op.h := h;
  133. IF m.doc.context # NIL THEN
  134. upd.doc := m.doc;
  135. Views.Domaincast(m.doc.Domain(), upd)
  136. END
  137. END Do;
  138. PROCEDURE (op: SetPageOp) Do;
  139. VAR d: StdDocument; pw, ph, pl, pt, pr, pb: INTEGER; decorate: BOOLEAN; upd: UpdateMsg;
  140. BEGIN
  141. d := op.d;
  142. pw := d.pw; ph := d.ph; pl := d.pl; pt := d.pt; pr := d.pr; pb := d.pb;
  143. decorate := d.decorate;
  144. d.pw := op.pw; d.ph := op.ph; d.pl := op.pl; d.pt := op.pt; d.pr := op.pr; d.pb := op.pb;
  145. d.decorate := op.decorate;
  146. op.pw := pw; op.ph := d.ph; op.pl := pl; op.pt := pt; op.pr := pr; op.pb := pb;
  147. op.decorate := decorate;
  148. IF d.context # NIL THEN
  149. upd.doc := d;
  150. Views.Domaincast(d.Domain(), upd)
  151. END
  152. END Do;
  153. PROCEDURE (op: ReplaceViewOp) Do;
  154. VAR new: Views.View; upd: UpdateMsg;
  155. BEGIN
  156. new := op.new; op.new := op.model.view; op.model.view := new;
  157. upd.doc := op.model.doc;
  158. IF upd.doc.context # NIL THEN
  159. Views.Domaincast(upd.doc.Domain(), upd)
  160. END
  161. END Do;
  162. (* printing support for StdDocument *)
  163. PROCEDURE CheckOrientation (d: Document; prt: Printers.Printer);
  164. VAR w, h, l, t, r, b: INTEGER; decorate: BOOLEAN;
  165. BEGIN
  166. d.PollPage(w, h, l, t, r, b, decorate);
  167. prt.SetOrientation(w > h)
  168. END CheckOrientation;
  169. PROCEDURE NewPrinterContext (d: Document; prt: Printers.Printer; p: Printing.Par): PrinterContext;
  170. VAR c: PrinterContext;
  171. pw, ph, x0, y0, x1, y1, l, t, r, b: INTEGER; decorate: BOOLEAN;
  172. BEGIN
  173. prt.GetRect(x0, y0, x1, y1);
  174. d.PollPage(pw, ph, l, t, r, b, decorate);
  175. INC(l, x0); INC(t, y0); INC(r, x0); INC(b, y0);
  176. NEW(c); (* c.Domain() := d.Domain(); (* dom *)*) c.param := p; Dates.GetDate(c.date); Dates.GetTime(c.time);
  177. c.pr := prt;
  178. c.l := l; c.t := t; c.r := r; c.b := b;
  179. c.pw := pw + 2 * x0; c.ph := ph + 2 * y0; (* paper reduced to printer range *)
  180. RETURN c
  181. END NewPrinterContext;
  182. PROCEDURE Decorate (c: PrinterContext; f: Views.Frame);
  183. VAR p: Printing.Par; x0, x1, y, asc, dsc, w: INTEGER; alt: BOOLEAN;
  184. BEGIN
  185. p := c.param;
  186. alt := p.page.alternate & ~ODD(p.page.first + Printing.Current() (* p.page.current *));
  187. IF alt THEN x0 := c.pw - c.r; x1 := c.pw - c.l
  188. ELSE x0 := c.l; x1 := c.r
  189. END;
  190. IF (alt & (p.header.left # "")) OR (~alt & (p.header.right # "")) THEN
  191. p.header.font.GetBounds(asc, dsc, w);
  192. y := c.t - p.header.gap - dsc;
  193. Printing.PrintBanner(f, p.page, p.header, c.date, c.time, x0, x1, y)
  194. END;
  195. IF (alt & (p.footer.left # "")) OR (~alt & (p.footer.right # "")) THEN
  196. p.footer.font.GetBounds(asc, dsc, w);
  197. y := c.b + p.footer.gap + asc;
  198. Printing.PrintBanner(f, p.page, p.footer, c.date, c.time, x0, x1, y)
  199. END
  200. END Decorate;
  201. (* support for StdDocument paging *)
  202. PROCEDURE HasFocus (v: Views.View; f: Views.Frame): BOOLEAN;
  203. VAR focus: Views.View; dummy: Controllers.PollFocusMsg;
  204. BEGIN
  205. focus := NIL; dummy.focus := NIL;
  206. v.HandleCtrlMsg(f, dummy, focus);
  207. RETURN focus # NIL
  208. END HasFocus;
  209. PROCEDURE ScrollDoc(v: StdDocument; x, y: INTEGER);
  210. BEGIN
  211. IF (x # v.x) OR (y # v.y) THEN
  212. Views.Scroll(v, x - v.x, y - v.y);
  213. v.x := x; v.y := y
  214. END
  215. END ScrollDoc;
  216. PROCEDURE PollSection (v: StdDocument; f: Views.Frame; VAR msg: Controllers.PollSectionMsg);
  217. VAR mv: Views.View; g: Views.Frame; vs, ps, ws, p, l, t, r, b: INTEGER; c: Containers.Controller;
  218. BEGIN
  219. mv := v.model.view;
  220. g := Views.ThisFrame(f, mv);
  221. c := v.ThisController();
  222. IF c.Singleton() # NIL THEN g := NIL END;
  223. IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END;
  224. IF (g = NIL) OR ~msg.done & (~msg.focus OR ~HasFocus(mv, g)) THEN
  225. v.PollRect(l, t, r, b);
  226. IF msg.vertical THEN
  227. ps := f.b - f.t; vs := b + t; p := -v.y
  228. ELSE
  229. ps := f.r - f.l; vs := r + l; p := -v.x
  230. END;
  231. IF ps > vs THEN ps := vs END;
  232. ws := vs - ps;
  233. IF p > ws THEN
  234. p := ws;
  235. IF msg.vertical THEN ScrollDoc(v, v.x, -p)
  236. ELSE ScrollDoc(v, -p, v.y)
  237. END
  238. END;
  239. msg.wholeSize := vs;
  240. msg.partSize := ps;
  241. msg.partPos := p;
  242. msg.valid := ws > Ports.point
  243. END;
  244. msg.done := TRUE
  245. END PollSection;
  246. PROCEDURE Scroll (v: StdDocument; f: Views.Frame; VAR msg: Controllers.ScrollMsg);
  247. VAR mv: Views.View; g: Views.Frame; vs, ps, ws, p, l, t, r, b: INTEGER; c: Containers.Controller;
  248. BEGIN
  249. mv := v.model.view;
  250. g := Views.ThisFrame(f, mv);
  251. c := v.ThisController();
  252. IF c.Singleton() # NIL THEN g := NIL END;
  253. IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END;
  254. IF (g = NIL) OR ~msg.done & (~msg.focus OR ~HasFocus(mv, g)) THEN
  255. v.PollRect(l, t, r, b);
  256. IF msg.vertical THEN
  257. ps := f.b - f.t; vs := b + t; p := -v.y
  258. ELSE
  259. ps := f.r - f.l; vs := r + l; p := -v.x
  260. END;
  261. ws := vs - ps;
  262. CASE msg.op OF
  263. Controllers.decLine: p := MAX(0, p - scrollUnit)
  264. | Controllers.incLine: p := MIN(ws, p + scrollUnit)
  265. | Controllers.decPage: p := MAX(0, p - ps + scrollUnit)
  266. | Controllers.incPage: p := MIN(ws, p + ps - scrollUnit)
  267. | Controllers.gotoPos: p := MAX(0, MIN(ws, msg.pos))
  268. ELSE
  269. END;
  270. IF msg.vertical THEN ScrollDoc(v, v.x, -p)
  271. ELSE ScrollDoc(v, -p, v.y)
  272. END
  273. END;
  274. msg.done := TRUE
  275. END Scroll;
  276. PROCEDURE MakeVisible* (d: Document; f: Views.Frame; l, t, r, b: INTEGER);
  277. VAR x, y, w, h, dw, dh, ml, mt, mr, mb: INTEGER;
  278. BEGIN
  279. WITH d: StdDocument DO
  280. d.context.GetSize(w, h);
  281. x := -d.x; y := -d.y;
  282. d.PollRect(ml, mt, mr, mb);
  283. dw := mr + ml - w; dh := mb + mt - h;
  284. IF dw > 0 THEN
  285. IF r > x + w - 2 * ml THEN x := r - w + 2 * ml END;
  286. IF l < x THEN x := l END;
  287. IF x < 0 THEN x := 0 ELSIF x > dw THEN x := dw END
  288. END;
  289. IF dh > 0 THEN
  290. IF b > y + h - 2 * mt THEN y := b - h + 2 * mt END;
  291. IF t < y THEN y := t END;
  292. IF y < 0 THEN y := 0 ELSIF y > dh THEN y := dh END
  293. END;
  294. ScrollDoc(d, -x, -y)
  295. END
  296. END MakeVisible;
  297. PROCEDURE Page (d: StdDocument; f: Views.Frame;
  298. VAR msg: Controllers.PageMsg);
  299. VAR g: Views.Frame;
  300. BEGIN
  301. g := Views.ThisFrame(f, d.model.view);
  302. IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END
  303. END Page;
  304. (* Model *)
  305. PROCEDURE (m: Model) Internalize (VAR rd: Stores.Reader);
  306. VAR c: StdContext; thisVersion: INTEGER; l, t, r, b: INTEGER;
  307. BEGIN
  308. m.Internalize^(rd);
  309. IF rd.cancelled THEN RETURN END;
  310. rd.ReadVersion(minVersion, maxModelVersion, thisVersion);
  311. IF rd.cancelled THEN RETURN END;
  312. Views.ReadView(rd, m.view);
  313. rd.ReadInt(l); rd.ReadInt(t); rd.ReadInt(r); rd.ReadInt(b);
  314. m.l := defB; m.t := defB; m.r := defB + r - l; m.b := defB + b - t;
  315. NEW(c); c.model := m; m.view.InitContext(c)
  316. END Internalize;
  317. PROCEDURE (m: Model) Externalize (VAR wr: Stores.Writer);
  318. BEGIN
  319. ASSERT(m.doc.original = NIL, 100);
  320. m.Externalize^(wr);
  321. wr.WriteVersion(maxModelVersion);
  322. Views.WriteView(wr, m.view);
  323. wr.WriteInt(m.l); wr.WriteInt(m.t); wr.WriteInt(m.r); wr.WriteInt(m.b)
  324. END Externalize;
  325. PROCEDURE (m: Model) CopyFrom (source: Stores.Store);
  326. VAR c: StdContext;
  327. BEGIN
  328. WITH source: Model DO
  329. m.view := Stores.CopyOf(source.view)(Views.View);
  330. m.l := source.l; m.t := source.t; m.r := source.r; m.b := source.b;
  331. NEW(c); c.model := m; m.view.InitContext(c)
  332. END
  333. END CopyFrom;
  334. PROCEDURE (m: Model) InitFrom (source: Containers.Model);
  335. VAR c: StdContext;
  336. BEGIN
  337. WITH source: Model DO
  338. m.view := Stores.CopyOf(source.view)(Views.View);
  339. m.l := source.l; m.t := source.t; m.r := source.r; m.b := source.b;
  340. NEW(c); c.model := m; m.view.InitContext(c)
  341. END
  342. END InitFrom;
  343. PROCEDURE (m: Model) GetEmbeddingLimits (OUT minW, maxW, minH, maxH: INTEGER);
  344. BEGIN
  345. minW := 5 * mm; minH := 5 * mm;
  346. maxW := MAX(INTEGER) DIV 2; maxH := MAX(INTEGER) DIV 2
  347. END GetEmbeddingLimits;
  348. PROCEDURE (m: Model) ReplaceView (old, new: Views.View);
  349. VAR con: Models.Context; op: ReplaceViewOp;
  350. BEGIN
  351. ASSERT(old # NIL, 20); con := old.context;
  352. ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = m, 22);
  353. ASSERT(new # NIL, 23);
  354. ASSERT((new.context = NIL) OR (new.context = con), 24);
  355. IF new # old THEN
  356. IF new.context = NIL THEN new.InitContext(con) END;
  357. Stores.Join(m, new);
  358. NEW(op); op.model := m; op.new := new;
  359. Models.Do(m, "#System:ReplaceView", op)
  360. END
  361. END ReplaceView;
  362. (* StdDocument *)
  363. PROCEDURE (d: StdDocument) Internalize2 (VAR rd: Stores.Reader);
  364. VAR thisVersion: INTEGER; c: Containers.Controller;
  365. BEGIN
  366. d.Internalize2^(rd);
  367. IF rd.cancelled THEN RETURN END;
  368. rd.ReadVersion(minVersion, maxStdDocVersion, thisVersion);
  369. IF rd.cancelled THEN RETURN END;
  370. rd.ReadInt(d.pw); rd.ReadInt(d.ph);
  371. rd.ReadInt(d.pl); rd.ReadInt(d.pt); rd.ReadInt(d.pr); rd.ReadInt(d.pb);
  372. rd.ReadBool(d.decorate);
  373. (* change infinite height to "fit to window" *)
  374. c := d.ThisController();
  375. IF (c # NIL) & (d.model.b >= 29000 * Ports.mm) & (c.opts * {winHeight, pageHeight} = {}) THEN
  376. c.SetOpts(c.opts + {winHeight})
  377. END;
  378. c.SetOpts(c.opts - {Containers.noSelection});
  379. d.x := 0; d.y := 0;
  380. Stores.InitDomain(d)
  381. END Internalize2;
  382. PROCEDURE (d: StdDocument) Externalize2 (VAR wr: Stores.Writer);
  383. BEGIN
  384. ASSERT(d.original = NIL, 100);
  385. d.Externalize2^(wr);
  386. wr.WriteVersion(maxStdDocVersion);
  387. wr.WriteInt(d.pw); wr.WriteInt(d.ph);
  388. wr.WriteInt(d.pl); wr.WriteInt(d.pt); wr.WriteInt(d.pr); wr.WriteInt(d.pb);
  389. wr.WriteBool(d.decorate)
  390. END Externalize2;
  391. PROCEDURE (d: StdDocument) CopyFromModelView2 (source: Views.View; model: Models.Model);
  392. BEGIN
  393. WITH source: StdDocument DO
  394. d.pw := source.pw; d.ph := source.ph;
  395. d.pl := source.pl; d.pt := source.pt; d.pr := source.pr; d.pb := source.pb;
  396. d.decorate := source.decorate
  397. END
  398. END CopyFromModelView2;
  399. PROCEDURE (d: StdDocument) AcceptableModel (m: Containers.Model): BOOLEAN;
  400. BEGIN
  401. RETURN m IS Model
  402. END AcceptableModel;
  403. PROCEDURE (d: StdDocument) InitModel2 (m: Containers.Model);
  404. BEGIN
  405. ASSERT((d.model = NIL) OR (d.model = m), 20);
  406. ASSERT(m IS Model, 23);
  407. WITH m: Model DO d.model := m; m.doc := d END
  408. END InitModel2;
  409. PROCEDURE (d: StdDocument) PollRect (VAR l, t, r, b: INTEGER);
  410. VAR c: Containers.Controller; doc: StdDocument; ww, wh, pw, ph: INTEGER;
  411. BEGIN
  412. IF d.original = NIL THEN doc := d ELSE doc := d.original END;
  413. l := d.model.l; t := d.model.t;
  414. pw := doc.pr - doc.pl; ph := doc.pb - doc.pt;
  415. IF d.context = NIL THEN ww := 0; wh := 0
  416. ELSIF d.context IS PrinterContext THEN ww := pw; wh := ph
  417. ELSE d.context.GetSize(ww, wh); DEC(ww, 2 * l); DEC(wh, 2 * t)
  418. END;
  419. c := d.ThisController();
  420. IF pageWidth IN c.opts THEN r := l + pw
  421. ELSIF winWidth IN c.opts THEN
  422. IF ww > 0 THEN r := l + ww ELSE r := d.model.r END
  423. ELSE r := l + doc.model.r - doc.model.l
  424. END;
  425. IF pageHeight IN c.opts THEN b := t + ph
  426. ELSIF winHeight IN c.opts THEN
  427. IF wh > 0 THEN b := t + wh ELSE b := d.model.b END
  428. ELSE b := t + doc.model.b - doc.model.t
  429. END;
  430. ASSERT(r > l, 60); ASSERT(b > t, 61)
  431. END PollRect;
  432. PROCEDURE (d: StdDocument) PollPage (VAR w, h, l, t, r, b: INTEGER; VAR decorate: BOOLEAN);
  433. VAR doc: StdDocument;
  434. BEGIN
  435. IF d.original = NIL THEN doc := d ELSE doc := d.original END;
  436. w := doc.pw; h := doc.ph;
  437. l := doc.pl; t := doc.pt; r := doc.pr; b := doc.pb;
  438. decorate := doc.decorate
  439. END PollPage;
  440. PROCEDURE (d: StdDocument) DocCopyOf (v: Views.View): Document;
  441. VAR c0, c1: Containers.Controller; u: Views.View; new: Document; w, h: INTEGER;
  442. BEGIN
  443. ASSERT(v # NIL, 20);
  444. ASSERT(~(v IS Document), 21);
  445. ASSERT(d.Domain() = v.Domain(), 22);
  446. ASSERT(d.Domain() # NIL, 23);
  447. Views.BeginModification(3, v);
  448. u := Views.CopyOf(v, Views.shallow);
  449. v.context.GetSize(w, h);
  450. new := dir.New(u, w, h);
  451. WITH new: StdDocument DO
  452. IF d.original # NIL THEN new.original := d.original ELSE new.original := d END
  453. END;
  454. c0 := d.ThisController();
  455. c1 := new.ThisController();
  456. c1.SetOpts(c0.opts);
  457. Views.EndModification(3, v);
  458. RETURN new
  459. END DocCopyOf;
  460. PROCEDURE (d: StdDocument) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  461. VAR c: Containers.Controller; m: Model; con: Models.Context; s: Views.View;
  462. BEGIN
  463. m := d.model; con := d.context;
  464. WITH con: PrinterContext DO
  465. IF con.param.page.alternate & ~ODD(con.param.page.first + Printing.Current()) THEN
  466. Views.InstallFrame(f, m.view, con.pw - con.r, con.t, 0, FALSE)
  467. ELSE
  468. Views.InstallFrame(f, m.view, con.l, con.t, 0, FALSE)
  469. END
  470. ELSE
  471. c := d.ThisController(); s := c.Singleton();
  472. Views.InstallFrame(f, m.view, m.l + d.x, m.t + d.y, 0, s = NIL)
  473. END
  474. END Restore;
  475. PROCEDURE (d: StdDocument) GetRect (f: Views.Frame; view: Views.View; OUT l, t, r, b: INTEGER);
  476. VAR l0, t0, r0, b0: INTEGER;
  477. BEGIN
  478. d.PollRect(l0, t0, r0, b0);
  479. l := l0 + d.x; t := t0 + d.y; r := r0 + d.x; b := b0 + d.y
  480. END GetRect;
  481. PROCEDURE (d: StdDocument) SetView (view: Views.View; w, h: INTEGER);
  482. CONST
  483. wA4 = 210 * mm; hA4 = 296 * mm; (* A4 default paper size *)
  484. lm = 20 * mm; tm = 20 * mm; rm = 20 * mm; bm = 20 * mm;
  485. VAR m: Model; c: StdContext; prt: Printers.Printer;
  486. ctrl: Containers.Controller; opts: SET; rp: Properties.ResizePref;
  487. u, minW, maxW, minH, maxH, defW, defH, dw, dh, pw, ph,
  488. pageW, pageH, paperW, paperH, leftM, topM, rightM, botM: INTEGER;
  489. l, t, r, b: INTEGER; port: Ports.Port;
  490. BEGIN
  491. ASSERT(view # NIL, 20); ASSERT(~(view IS Document), 21);
  492. ASSERT(d.original = NIL, 100);
  493. m := d.model;
  494. NEW(c); c.model := m; view.InitContext(c);
  495. IF d.context # NIL THEN Stores.Join(d, view) END;
  496. IF Printers.dir # NIL THEN prt := Printers.dir.Current() ELSE prt := NIL END;
  497. IF prt # NIL THEN
  498. prt.SetOrientation(FALSE);
  499. port := prt.ThisPort(); prt.GetRect(l, t, r, b);
  500. port.GetSize(pw, ph); u := port.unit;
  501. paperW := r - l; paperH := b - t;
  502. pageW := paperW - lm - rm; pageH := paperH - tm - bm;
  503. leftM := lm; topM := tm; rightM := rm; botM := bm;
  504. IF pageW > pw * u THEN pageW := pw * u END;
  505. IF pageH > ph * u THEN pageH := ph * u END;
  506. IF leftM + l < 0 THEN dw := -(leftM + l)
  507. ELSIF paperW - rightM + l > pw * u THEN dw := pw * u - (paperW - rightM + l)
  508. ELSE dw := 0
  509. END;
  510. IF topM + t < 0 THEN dh := -(topM + t)
  511. ELSIF paperH - botM + t > ph * u THEN dh := ph * u - (paperH - botM + t)
  512. ELSE dh := 0
  513. END;
  514. INC(leftM, dw); INC(topM, dh); INC(rightM, dw); INC(botM, dh)
  515. ELSE
  516. paperW := wA4; paperH := hA4;
  517. pageW := paperW - lm - rm; pageH := paperH - tm - bm;
  518. leftM := lm; topM := tm; rightM := rm; botM := bm
  519. END;
  520. m.GetEmbeddingLimits(minW, maxW, minH, maxH);
  521. defW := MAX(minW, pageW - m.l - defB);
  522. defH := MAX(minH, pageH - m.t - defB);
  523. Properties.PreferredSize(view, minW, maxW, minH, maxH, defW, defH, w, h);
  524. opts := {}; rp.fixed := FALSE;
  525. rp.horFitToPage := FALSE;
  526. rp.verFitToPage := FALSE;
  527. rp.horFitToWin := FALSE;
  528. rp.verFitToWin := FALSE;
  529. Views.HandlePropMsg(view, rp);
  530. IF rp.horFitToPage THEN INCL(opts, pageWidth)
  531. ELSIF rp.horFitToWin THEN INCL(opts, winWidth)
  532. END;
  533. IF rp.verFitToPage THEN INCL(opts, pageHeight)
  534. ELSIF rp.verFitToWin THEN INCL(opts, winHeight)
  535. END;
  536. Views.BeginModification(Views.notUndoable, d);
  537. m.view := view; d.x := 0; d.y := 0;
  538. ctrl := d.ThisController();
  539. ctrl.SetOpts(ctrl.opts - {pageWidth..winHeight});
  540. d.SetPage(paperW, paperH, leftM, topM, paperW - rightM, paperH - botM, plain);
  541. ASSERT(w > 0, 100); ASSERT(h > 0, 101);
  542. d.SetRect(m.l, m.t, m.l + w, m.t + h);
  543. ctrl.SetOpts(ctrl.opts + opts);
  544. Views.EndModification(Views.notUndoable, d);
  545. Stores.Join(d, view);
  546. Views.Update(d, Views.rebuildFrames)
  547. END SetView;
  548. PROCEDURE (d: StdDocument) ThisView (): Views.View;
  549. BEGIN
  550. RETURN d.model.view
  551. END ThisView;
  552. PROCEDURE (d: StdDocument) OriginalView (): Views.View;
  553. BEGIN
  554. IF d.original = NIL THEN RETURN d.model.view
  555. ELSE RETURN d.original.model.view
  556. END
  557. END OriginalView;
  558. PROCEDURE (d: StdDocument) SetRect (l, t, r, b: INTEGER);
  559. VAR m: Model; op: SetRectOp; c: Containers.Controller; w, h: INTEGER;
  560. BEGIN
  561. ASSERT(l < r, 22); ASSERT(t < b, 25);
  562. m := d.model;
  563. IF (m.l # l) OR (m.t # t) THEN
  564. m.r := l + m.r - m.l; m.l := l;
  565. m.b := t + m.b - m.t; m.t := t;
  566. Views.Update(d, Views.rebuildFrames)
  567. END;
  568. IF d.original # NIL THEN m := d.original.model END;
  569. c := d.ThisController(); w := r - l; h := b - t;
  570. IF (pageWidth IN c.opts) OR (winWidth IN c.opts) THEN w := m.r - m.l END;
  571. IF (pageHeight IN c.opts) OR (winHeight IN c.opts) THEN h := m.b - m.t END;
  572. IF (w # m.r - m.l) OR (h # m.b - m.t) THEN
  573. NEW(op); op.model := m; op.w:= w; op.h := h;
  574. Views.Do(d, resizingKey, op)
  575. END
  576. END SetRect;
  577. PROCEDURE (d: StdDocument) SetPage (pw, ph, pl, pt, pr, pb: INTEGER; decorate: BOOLEAN);
  578. VAR op: SetPageOp; doc: StdDocument;
  579. BEGIN
  580. IF d.original = NIL THEN doc := d ELSE doc := d.original END;
  581. IF (doc.pw # pw) OR (doc.ph # ph) OR (doc.decorate # decorate)
  582. OR (doc.pl # pl) OR (doc.pt # pt) OR (doc.pr # pr) OR (doc.pb # pb) THEN
  583. ASSERT(0 <= pw, 20);
  584. ASSERT(0 <= ph, 22);
  585. ASSERT(0 <= pl, 24); ASSERT(pl < pr, 25); ASSERT(pr <= pw, 26);
  586. ASSERT(0 <= pt, 27); ASSERT(pt < pb, 28); ASSERT(pb <= ph, 29);
  587. NEW(op);
  588. op.d := doc;
  589. op.pw := pw; op.ph := ph; op.pl := pl; op.pt := pt; op.pr := pr; op.pb := pb;
  590. op.decorate := decorate;
  591. Views.Do(doc, pageSetupKey, op)
  592. END
  593. END SetPage;
  594. PROCEDURE (v: StdDocument) HandleViewMsg2 (f: Views.Frame; VAR msg: Views.Message);
  595. BEGIN
  596. WITH msg: UpdateMsg DO
  597. IF (msg.doc = v) OR (msg.doc = v.original) THEN
  598. Views.Update(v, Views.rebuildFrames)
  599. END
  600. ELSE
  601. END
  602. END HandleViewMsg2;
  603. PROCEDURE (d: StdDocument) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
  604. VAR focus: Views.View);
  605. BEGIN
  606. WITH f: Views.RootFrame DO
  607. WITH msg: Controllers.PollSectionMsg DO
  608. PollSection(d, f, msg); focus := NIL
  609. | msg: Controllers.ScrollMsg DO
  610. Scroll(d, f, msg); focus := NIL
  611. | msg: Controllers.PageMsg DO
  612. Page(d, f, msg); focus := NIL
  613. ELSE
  614. END
  615. END
  616. END HandleCtrlMsg2;
  617. (* Controller *)
  618. PROCEDURE (c: Controller) Internalize2 (VAR rd: Stores.Reader);
  619. VAR v: INTEGER;
  620. BEGIN
  621. rd.ReadVersion(minVersion, maxCtrlVersion, v)
  622. END Internalize2;
  623. PROCEDURE (c: Controller) Externalize2 (VAR wr: Stores.Writer);
  624. BEGIN
  625. wr.WriteVersion(maxCtrlVersion)
  626. END Externalize2;
  627. PROCEDURE (c: Controller) InitView2 (v: Views.View);
  628. BEGIN
  629. IF v # NIL THEN c.doc := v(StdDocument) ELSE c.doc := NIL END
  630. END InitView2;
  631. PROCEDURE (c: Controller) GetContextType (OUT type: Stores.TypeName);
  632. END GetContextType;
  633. PROCEDURE (c: Controller) GetValidOps (OUT valid: SET);
  634. BEGIN
  635. IF c.Singleton() # NIL THEN
  636. valid := {Controllers.copy}
  637. END
  638. END GetValidOps;
  639. PROCEDURE (c: Controller) NativeModel (m: Models.Model): BOOLEAN;
  640. BEGIN
  641. RETURN m IS Model
  642. END NativeModel;
  643. PROCEDURE (c: Controller) NativeView (v: Views.View): BOOLEAN;
  644. BEGIN
  645. RETURN v IS StdDocument
  646. END NativeView;
  647. PROCEDURE (c: Controller) NativeCursorAt (f: Views.Frame; x, y: INTEGER): INTEGER;
  648. BEGIN
  649. RETURN Ports.arrowCursor
  650. END NativeCursorAt;
  651. PROCEDURE (c: Controller) PollNativeProp (selection: BOOLEAN; VAR p: Properties.Property;
  652. VAR truncated: BOOLEAN);
  653. END PollNativeProp;
  654. PROCEDURE (c: Controller) SetNativeProp (selection: BOOLEAN; p, old: Properties.Property);
  655. END SetNativeProp;
  656. PROCEDURE (c: Controller) GetFirstView (selection: BOOLEAN; OUT v: Views.View);
  657. BEGIN
  658. IF selection THEN v := c.Singleton() ELSE v := c.doc.model.view END
  659. END GetFirstView;
  660. PROCEDURE (c: Controller) GetNextView (selection: BOOLEAN; VAR v: Views.View);
  661. BEGIN
  662. v := NIL
  663. END GetNextView;
  664. PROCEDURE (c: Controller) GetPrevView (selection: BOOLEAN; VAR v: Views.View);
  665. BEGIN
  666. v := NIL
  667. END GetPrevView;
  668. PROCEDURE (c: Controller) TrackMarks (f: Views.Frame; x, y: INTEGER;
  669. units, extend, add: BOOLEAN);
  670. BEGIN
  671. c.Neutralize
  672. END TrackMarks;
  673. PROCEDURE (c: Controller) RestoreMarks2 (f: Views.Frame; l, t, r, b: INTEGER);
  674. BEGIN
  675. IF c.doc.context IS PrinterContext THEN Decorate(c.doc.context(PrinterContext), f) END
  676. END RestoreMarks2;
  677. PROCEDURE (c: Controller) Resize (view: Views.View; l, t, r, b: INTEGER);
  678. VAR d: StdDocument; l0, t0: INTEGER;
  679. BEGIN
  680. d := c.doc;
  681. ASSERT(view = d.model.view, 20);
  682. l0 := d.model.l; t0 := d.model.t;
  683. d.SetRect(l0, t0, l0 + r - l, t0 + b - t)
  684. END Resize;
  685. PROCEDURE (c: Controller) DeleteSelection;
  686. END DeleteSelection;
  687. PROCEDURE (c: Controller) MoveLocalSelection (f, dest: Views.Frame; x, y: INTEGER;
  688. dx, dy: INTEGER);
  689. VAR m: Model; l, t, r, b: INTEGER;
  690. BEGIN
  691. IF f = dest THEN
  692. m := c.doc.model; DEC(dx, x); DEC(dy, y);
  693. l := m.l + dx; t := m.t + dy;
  694. r := m.r + dx; b := m.b + dy;
  695. c.Resize(m.view, l, t, r, b);
  696. IF c.Singleton() = NIL THEN c.SetSingleton(m.view) END
  697. END
  698. END MoveLocalSelection;
  699. PROCEDURE (c: Controller) SelectionCopy (): Model;
  700. BEGIN
  701. RETURN NIL
  702. END SelectionCopy;
  703. PROCEDURE (c: Controller) NativePaste (m: Models.Model; f: Views.Frame);
  704. VAR m0: Model;
  705. BEGIN
  706. WITH m: Model DO
  707. m0 := c.doc.model;
  708. m0.ReplaceView(m0.view, m.view);
  709. c.doc.SetRect(m.l, m.t, m.r, m.b)
  710. END
  711. END NativePaste;
  712. PROCEDURE (c: Controller) PasteView (f: Views.Frame; v: Views.View; w, h: INTEGER);
  713. VAR m: Model; minW, maxW, minH, maxH, defW, defH: INTEGER;
  714. BEGIN
  715. m := c.doc.model;
  716. m.GetEmbeddingLimits(minW, maxW, minH, maxH);
  717. defW := m.r - m.l; defH := m.b - m.t;
  718. Properties.PreferredSize(v, minW, maxW, minH, maxH, defW, defH, w, h);
  719. m.ReplaceView(m.view, v);
  720. c.doc.SetRect(m.l, m.t, m.l + w, m.t + h)
  721. END PasteView;
  722. PROCEDURE (c: Controller) Drop (src, dst: Views.Frame; sx, sy, x, y, w, h, rx, ry: INTEGER;
  723. v: Views.View; isSingle: BOOLEAN);
  724. VAR m: Model; minW, maxW, minH, maxH, defW, defH: INTEGER;
  725. BEGIN
  726. m := c.doc.model;
  727. m.GetEmbeddingLimits(minW, maxW, minH, maxH);
  728. defW := m.r - m.l; defH := m.b - m.t;
  729. Properties.PreferredSize(v, minW, maxW, minH, maxH, defW, defH, w, h);
  730. m.ReplaceView(m.view, v);
  731. c.doc.SetRect(m.l, m.t, m.l + w, m.t + h)
  732. END Drop;
  733. (* selection *)
  734. PROCEDURE (c: Controller) Selectable (): BOOLEAN;
  735. BEGIN
  736. RETURN TRUE
  737. END Selectable;
  738. PROCEDURE (c: Controller) SelectAll (select: BOOLEAN);
  739. BEGIN
  740. IF ~select & (c.Singleton() # NIL) THEN
  741. c.SetSingleton(NIL)
  742. ELSIF select & (c.Singleton() = NIL) THEN
  743. c.SetSingleton(c.doc.model.view)
  744. END
  745. END SelectAll;
  746. PROCEDURE (c: Controller) InSelection (f: Views.Frame; x, y: INTEGER): BOOLEAN;
  747. BEGIN
  748. RETURN c.Singleton() # NIL
  749. END InSelection;
  750. (* caret *)
  751. PROCEDURE (c: Controller) HasCaret (): BOOLEAN;
  752. BEGIN
  753. RETURN FALSE
  754. END HasCaret;
  755. PROCEDURE (c: Controller) MarkCaret (f: Views.Frame; show: BOOLEAN);
  756. END MarkCaret;
  757. PROCEDURE (c: Controller) CanDrop (f: Views.Frame; x, y: INTEGER): BOOLEAN;
  758. BEGIN
  759. RETURN FALSE
  760. END CanDrop;
  761. (* handlers *)
  762. PROCEDURE (c: Controller) HandleCtrlMsg (f: Views.Frame;
  763. VAR msg: Controllers.Message; VAR focus: Views.View);
  764. VAR l, t, r, b: INTEGER;
  765. BEGIN
  766. IF ~(Containers.noFocus IN c.opts) THEN
  767. WITH msg: Controllers.TickMsg DO
  768. IF c.Singleton() = NIL THEN c.SetFocus(c.doc.model.view) END
  769. | msg: Controllers.CursorMessage DO
  770. IF c.Singleton() = NIL THEN (* delegate to focus, even if not directly hit *)
  771. focus := c.ThisFocus();
  772. c.doc.GetRect(f, focus, l, t, r, b); (* except for resize in lower right corner *)
  773. IF (c.opts * {pageWidth..winHeight} # {})
  774. OR (msg.x < r) OR (msg.y < b) THEN RETURN END
  775. END
  776. ELSE
  777. END
  778. END;
  779. c.HandleCtrlMsg^(f, msg, focus)
  780. END HandleCtrlMsg;
  781. PROCEDURE (c: Controller) PasteChar (ch: CHAR);
  782. END PasteChar;
  783. PROCEDURE (c: Controller) ControlChar (f: Views.Frame; ch: CHAR);
  784. END ControlChar;
  785. PROCEDURE (c: Controller) ArrowChar (f: Views.Frame; ch: CHAR; units, select: BOOLEAN);
  786. END ArrowChar;
  787. PROCEDURE (c: Controller) CopyLocalSelection (src, dst: Views.Frame; sx, sy, dx, dy: INTEGER);
  788. END CopyLocalSelection;
  789. (* StdContext *)
  790. PROCEDURE (c: StdContext) ThisModel (): Models.Model;
  791. BEGIN
  792. RETURN c.model
  793. END ThisModel;
  794. PROCEDURE (c: StdContext) GetSize (OUT w, h: INTEGER);
  795. VAR m: Model; dc: Models.Context; l, t, r, b: INTEGER;
  796. BEGIN
  797. m := c.model;
  798. m.doc.PollRect(l, t, r, b); w := r - l; h := b - t;
  799. dc := m.doc.context;
  800. IF dc # NIL THEN
  801. WITH dc: PrinterContext DO
  802. w := MIN(w, dc.r - dc.l); h := MIN(h, dc.b - dc.t)
  803. ELSE
  804. END
  805. END;
  806. ASSERT(w > 0, 60); ASSERT(h > 0, 61)
  807. END GetSize;
  808. PROCEDURE (c: StdContext) SetSize (w, h: INTEGER);
  809. VAR m: Model; d: StdDocument; minW, maxW, minH, maxH, defW, defH: INTEGER;
  810. BEGIN
  811. m := c.model; d := m.doc; ASSERT(d # NIL, 20);
  812. m.GetEmbeddingLimits(minW, maxW, minH, maxH);
  813. defW := m.r - m.l; defH := m.b - m.t;
  814. Properties.PreferredSize(m.view, minW, maxW, minH, maxH, defW, defH, w, h);
  815. d.SetRect(m.l, m.t, m.l + w, m.t + h)
  816. END SetSize;
  817. PROCEDURE (c: StdContext) Normalize (): BOOLEAN;
  818. BEGIN
  819. RETURN TRUE
  820. END Normalize;
  821. PROCEDURE (c: StdContext) ThisDoc (): Document;
  822. BEGIN
  823. RETURN c.model.doc
  824. END ThisDoc;
  825. PROCEDURE (c: StdContext) MakeVisible (l, t, r, b: INTEGER);
  826. BEGIN
  827. MakeVisible(c.model.doc, NIL, l, t, r, b)
  828. END MakeVisible;
  829. (* PrinterContext *)
  830. PROCEDURE (c: PrinterContext) GetSize (OUT w, h: INTEGER);
  831. VAR p: Ports.Port;
  832. BEGIN
  833. p := c.pr.ThisPort();
  834. p.GetSize(w, h);
  835. w := w * p.unit;
  836. h := h * p.unit
  837. END GetSize;
  838. PROCEDURE (c: PrinterContext) Normalize (): BOOLEAN;
  839. BEGIN
  840. RETURN TRUE
  841. END Normalize;
  842. PROCEDURE (c: PrinterContext) SetSize (w, h: INTEGER);
  843. END SetSize;
  844. PROCEDURE (c: PrinterContext) ThisModel (): Models.Model;
  845. BEGIN
  846. RETURN NIL
  847. END ThisModel;
  848. (* StdDirectory *)
  849. PROCEDURE (d: StdDirectory) New (view: Views.View; w, h: INTEGER): Document;
  850. VAR doc: StdDocument; m: Model; c: Controller;
  851. BEGIN
  852. ASSERT(view # NIL, 20); ASSERT(~(view IS Document), 21);
  853. NEW(m);
  854. NEW(doc); doc.InitModel(m);
  855. NEW(c); doc.SetController(c);
  856. doc.SetRect(defB, defB, defB + 1, defB + 1); (* set top-left point *)
  857. doc.SetView(view, w, h); (* joins store graphs of doc and view *)
  858. Stores.InitDomain(doc); (* domains of new documents are bound *)
  859. RETURN doc
  860. END New;
  861. (** PContext **)
  862. PROCEDURE (c: PContext) GetSize (OUT w, h: INTEGER);
  863. BEGIN
  864. w := c.w; h := c.h
  865. END GetSize;
  866. PROCEDURE (c: PContext) Normalize (): BOOLEAN;
  867. BEGIN
  868. RETURN TRUE
  869. END Normalize;
  870. PROCEDURE (c: PContext) SetSize (w, h: INTEGER);
  871. END SetSize;
  872. PROCEDURE (c: PContext) ThisModel (): Models.Model;
  873. BEGIN
  874. RETURN NIL
  875. END ThisModel;
  876. (** Pager **)
  877. PROCEDURE (p: Pager) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  878. BEGIN
  879. Views.InstallFrame(f, p.con.view, -p.x, -p.y, 0, FALSE)
  880. END Restore;
  881. PROCEDURE (p: Pager) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View);
  882. VAR v: Views.View; g: Views.Frame;
  883. BEGIN
  884. WITH msg: Controllers.PageMsg DO
  885. v := p.con.view; g := Views.ThisFrame(f, v);
  886. IF g = NIL THEN
  887. Views.InstallFrame(f, v, 0, 0, 0, FALSE);
  888. g := Views.ThisFrame(f, v)
  889. END;
  890. IF g # NIL THEN
  891. Views.ForwardCtrlMsg(g, msg);
  892. IF ~msg.done THEN
  893. IF p.con.w > p.w THEN (* needs horizontal paging *)
  894. IF msg.op = Controllers.gotoPageX THEN p.x := msg.pageX * p.w; msg.done := TRUE
  895. ELSIF msg.op = Controllers.nextPageX THEN p.x := p.x + p.w; msg.done := TRUE
  896. END;
  897. IF p.x >= p.con.w THEN msg.eox := TRUE; p.x := 0 END
  898. END;
  899. IF p.con.h > p.h THEN (* needs vertical paging *)
  900. IF msg.op = Controllers.gotoPageY THEN p.y := msg.pageY * p.h; msg.done := TRUE
  901. ELSIF msg.op = Controllers.nextPageY THEN p.y := p.y + p.h; msg.done := TRUE
  902. END;
  903. IF p.y >= p.con.h THEN msg.eoy := TRUE; p.y := 0 END
  904. END
  905. END
  906. END
  907. ELSE focus := p.con.view
  908. END
  909. END HandleCtrlMsg;
  910. PROCEDURE NewPager (v: Views.View; w, h, pw, ph: INTEGER): Pager;
  911. VAR p: Pager; c: PContext;
  912. BEGIN
  913. NEW(c); c.view := v; c.w := w; c.h := h; v.InitContext(c);
  914. NEW(p); p.con := c; p.w := pw; p.h := ph; p.x := 0; p.y := 0;
  915. Stores.Join(v, p);
  916. RETURN p
  917. END NewPager;
  918. PROCEDURE PrinterDoc (d: Document; c: PrinterContext): Document;
  919. VAR v, u, p: Views.View; w, h, l, t, r, b, pw, ph: INTEGER; pd: Document;
  920. ct: Containers.Controller; dec: BOOLEAN; seq: ANYPTR;
  921. BEGIN
  922. v := d.ThisView();
  923. IF d.Domain() # NIL THEN seq:=d.Domain().GetSequencer();
  924. IF seq#NIL THEN seq(Sequencers.Sequencer).BeginModification(Sequencers.invisible, d) END
  925. END;
  926. u := Views.CopyOf(v, Views.shallow);
  927. IF d.Domain() # NIL THEN seq:=d.Domain().GetSequencer();
  928. IF seq#NIL THEN seq(Sequencers.Sequencer).EndModification(Sequencers.invisible, d) END
  929. END;
  930. d.PollPage(w, h, l, t, r, b, dec); pw := r - l; ph := b - t; (* page size *)
  931. v.context.GetSize(w, h);
  932. ct := d.ThisController();
  933. IF winWidth IN ct.opts THEN w := pw END; (* fit to win -> fit to page *)
  934. IF winHeight IN ct.opts THEN h := ph END;
  935. p := NewPager(u, w, h, pw, ph);
  936. ASSERT(Stores.Joined(p, d), 100);
  937. pd := dir.New(p, pw, ph);
  938. pd.InitContext(c);
  939. RETURN pd
  940. END PrinterDoc;
  941. (** miscellaneous **)
  942. PROCEDURE Print* (d: Document; p: Printers.Printer; par: Printing.Par);
  943. VAR dom: Stores.Domain; d1: Document; f: Views.RootFrame; g: Views.Frame;
  944. c: PrinterContext; from, to, this, copies, w, h, u, k: INTEGER; page: Controllers.PageMsg;
  945. title: Views.Title; port: Ports.Port;
  946. BEGIN
  947. ASSERT(d # NIL, 20); ASSERT(p # NIL, 21);
  948. ASSERT(par # NIL, 22);
  949. ASSERT(par.page.from >= 0, 23); ASSERT(par.page.from <= par.page.to, 24);
  950. ASSERT(par.copies > 0, 25);
  951. IF (par.header.right # "") OR (par.page.alternate & (par.header.left # "")) THEN
  952. ASSERT(par.header.font # NIL, 26)
  953. END;
  954. IF (par.footer.right # "") OR (par.page.alternate & (par.footer.left # "")) THEN
  955. ASSERT(par.footer.font # NIL, 27)
  956. END;
  957. IF par.page.title = "" THEN title := "(" + Dialog.appName + ")" ELSE title := par.page.title END;
  958. from := par.page.from; to := par.page.to;
  959. copies := par.copies;
  960. CheckOrientation(d, p);
  961. p.OpenJob(copies, title);
  962. IF p.res = 0 THEN
  963. dom := d.Domain();
  964. ASSERT(dom # NIL, 100);
  965. c := NewPrinterContext(d, p, par);
  966. d1 := PrinterDoc(d, c);
  967. CheckOrientation(d, p); (* New in PrinterDoc resets printer orientation *)
  968. d1.GetNewFrame(g); f := g(Views.RootFrame); f.ConnectTo(p.ThisPort());
  969. Views.SetRoot(f, d1, FALSE, {}); Views.AdaptRoot(f);
  970. current := 0; (*par.page.current := 0; *)
  971. d1.Restore(f, 0, 0, 0, 0); (* install frame for doc's view *)
  972. Kernel.PushTrapCleaner(cleaner);
  973. port := p.ThisPort();
  974. Printing.par := par;
  975. page.op := Controllers.gotoPageX; page.pageX := 0;
  976. page.done := FALSE; page.eox := FALSE;
  977. Views.ForwardCtrlMsg(f, page);
  978. IF page.done THEN this := 0 ELSE this := from END;
  979. page.op := Controllers.gotoPageY; page.pageY := this;
  980. page.done := FALSE; page.eoy := FALSE;
  981. Views.ForwardCtrlMsg(f, page);
  982. IF ~page.done & (from > 0) OR page.eox OR page.eoy THEN to := -1 END;
  983. WHILE this <= to DO
  984. IF this >= from THEN
  985. current := this; (*par.page.current := this;*)
  986. port.GetSize(w, h); u := port.unit;
  987. FOR k := copies TO par.copies DO
  988. p.OpenPage;
  989. IF p.res = 0 THEN
  990. Views.RemoveFrames(f, 0, 0, w * u, h * u);
  991. Views.RestoreRoot(f, 0, 0, w * u, h * u)
  992. END;
  993. p.ClosePage
  994. END
  995. END;
  996. IF p.res # abort THEN INC(this) ELSE to := -1 END;
  997. IF this <= to THEN
  998. page.op := Controllers.nextPageX;
  999. page.done := FALSE; page.eox := FALSE;
  1000. Views.ForwardCtrlMsg(f, page);
  1001. IF ~page.done OR page.eox THEN
  1002. IF page.done THEN
  1003. page.op := Controllers.gotoPageX; page.pageX := 0;
  1004. page.done := FALSE; page.eox := FALSE;
  1005. Views.ForwardCtrlMsg(f, page)
  1006. END;
  1007. page.op := Controllers.nextPageY;
  1008. page.done := FALSE; page.eoy := FALSE;
  1009. Views.ForwardCtrlMsg(f, page);
  1010. IF ~page.done OR page.eoy THEN to := -1 END
  1011. END
  1012. END
  1013. END;
  1014. Printing.par := NIL;
  1015. Kernel.PopTrapCleaner(cleaner)
  1016. ELSE Dialog.ShowMsg("#System:FailedToOpenPrintJob")
  1017. END;
  1018. p.CloseJob
  1019. END Print;
  1020. PROCEDURE (hook: PrintingHook) Current(): INTEGER;
  1021. BEGIN
  1022. RETURN current
  1023. END Current;
  1024. PROCEDURE (hook: PrintingHook) Print (v: Views.View; par: Printing.Par);
  1025. VAR dom: Stores.Domain; d: Document; f: Views.RootFrame; c: PrinterContext;
  1026. w, h, u: INTEGER; p: Printers.Printer; g: Views.Frame; title: Views.Title;
  1027. k, copies: INTEGER; port: Ports.Port;
  1028. BEGIN
  1029. ASSERT(v # NIL, 20);
  1030. p := Printers.dir.Current();
  1031. ASSERT(p # NIL, 21);
  1032. IF v IS Document THEN Print(v(Document), p, par); RETURN END;
  1033. IF (v.context # NIL) & (v.context IS Context) THEN
  1034. Print(v.context(Context).ThisDoc(), p, par); RETURN
  1035. END;
  1036. p.SetOrientation(FALSE);
  1037. IF par.page.title = "" THEN title := "(" + Dialog.appName + ")" ELSE title := par.page.title END;
  1038. copies := par.copies;
  1039. p.OpenJob(copies, title);
  1040. IF p.res = 0 THEN
  1041. Printing.par := par;
  1042. Stores.InitDomain(v);
  1043. dom := v.Domain();
  1044. v := Views.CopyOf(v, Views.shallow) ;
  1045. d := dir.New(v, Views.undefined, Views.undefined);
  1046. c := NewPrinterContext(d, (* dom, *) p, par);
  1047. d.InitContext(c); (* Stores.InitDomain(d, c.Domain()); (* nicht mehr noetig *) *)
  1048. d.GetNewFrame(g); f := g(Views.RootFrame);
  1049. port := p.ThisPort(); f.ConnectTo(port);
  1050. Views.SetRoot(f, d, FALSE, {}); Views.AdaptRoot(f);
  1051. port.GetSize(w, h); u := port.unit;
  1052. FOR k := copies TO par.copies DO
  1053. p.OpenPage;
  1054. IF p.res = 0 THEN
  1055. Views.RemoveFrames(f, 0, 0, w * u, h * u); Views.RestoreRoot(f, 0, 0, w * u, h * u)
  1056. END;
  1057. p.ClosePage
  1058. END
  1059. END;
  1060. Printing.par := NIL;
  1061. p.CloseJob
  1062. END Print;
  1063. PROCEDURE ImportDocument* (f: Files.File; OUT s: Stores.Store);
  1064. VAR r: Stores.Reader; tag, version: INTEGER;
  1065. BEGIN
  1066. ASSERT(f # NIL, 20);
  1067. r.ConnectTo(f);
  1068. r.ReadInt(tag);
  1069. IF tag = docTag THEN
  1070. r.ReadInt(version);
  1071. ASSERT(version = docVersion, 100);
  1072. r.ReadStore(s);
  1073. IF s IS Document THEN s := s(Document).ThisView()
  1074. ELSE s := NIL
  1075. END
  1076. END
  1077. END ImportDocument;
  1078. PROCEDURE ExportDocument* (s: Stores.Store; f: Files.File);
  1079. VAR w: Stores.Writer; v: Views.View;
  1080. BEGIN
  1081. ASSERT(s # NIL, 20);
  1082. ASSERT(s IS Views.View, 21);
  1083. ASSERT(f # NIL, 22);
  1084. v := s(Views.View);
  1085. IF (v.context # NIL) & (v.context IS Context) THEN
  1086. v := v.context(Context).ThisDoc()
  1087. END;
  1088. IF ~(v IS Document) THEN
  1089. IF v.context # NIL THEN
  1090. v := Views.CopyOf(v, Views.shallow)
  1091. END;
  1092. v := dir.New(v, Views.undefined, Views.undefined)
  1093. END;
  1094. w.ConnectTo(f);
  1095. w.WriteInt(docTag); w.WriteInt(docVersion);
  1096. w.WriteStore(v)
  1097. END ExportDocument;
  1098. PROCEDURE SetDir* (d: Directory);
  1099. BEGIN
  1100. ASSERT(d # NIL, 20);
  1101. dir := d;
  1102. IF stdDir = NIL THEN stdDir := d END
  1103. END SetDir;
  1104. PROCEDURE Init;
  1105. VAR d: StdDirectory; h: PrintingHook;
  1106. BEGIN
  1107. NEW(d); SetDir(d);
  1108. NEW(h); Printing.SetHook(h);
  1109. NEW(cleaner)
  1110. END Init;
  1111. BEGIN
  1112. Init
  1113. END Documents.