TIP Render

Check-in [2fa6f61b95]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Current state of the tip render system.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:2fa6f61b957d6c84f5e56cef5390455ceec86c26
User & Date: aku 2015-10-21 23:01:56
Context
2015-10-22
00:11
Sort files into apps, lib code, and other. Begin the deconstruction. check-in: 4c32efc77c user: aku tags: destructure
2015-10-21
23:01
Current state of the tip render system. Leaf check-in: 2fa6f61b95 user: aku tags: trunk
22:53
initial empty check-in check-in: baa599ba39 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added ChangeLog.










































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
2012-04-20  Donal K. Fellows  <[email protected]>

	* tip.tcl (serveIndex, serveFrameset): Rewrite so that the sidebar of
	* tiphtml.tcl (index): TIPs is somewhat more useful by default on some
	platforms (notably iOS). Not necessarily the end of these changes.

	* parse.tcl (foreachTIPreverse): New utility function to support
	iterating over TIPs in reverse numerical order.

2009-10-21  Donal K. Fellows  <[email protected]>

	* edit.tcl (isWikispam, attemptCommit): Make the reasons for failure
	to save more apparent. The fix is for the person with a problem to
	contact me directly.

2008-12-03  Donal K. Fellows  <[email protected]>

	* conf_def.tcl, config.tcl (ISSUEBASE):
	* parse.tcl (ISSUEURLRE):
	* tip*.tcl: Make 'issue:1234567' link to a bug report or issue as a
	shorthand. Much less error-prone than typing it by hand.

2007-07-03  Donal K. Fellows  <[email protected]>

	* tip.tcl, edit.tcl (attemptCommit): Add some more anti-spamming
	measures.

2007-02-07  Donal K. Fellows  <[email protected]>

	* tip.tcl (serveTclIndex): Add a way of retrieving the TIP index that
	is suitable for simple reading by a Tcl script. Thanks to Joe English
	for the suggestion.

2006-05-31  Donal K. Fellows  <[email protected]>

	* parse.tcl (intuitParagraphKind): Adjusted to be more forgiving of
	poorly formatted verbatim paragraphs.

2005-05-17  Donal K. Fellows  <[email protected]>

	* tiptex.tcl (quote): TIP#237 prompts a better fix for the ^ character.

	Sometimes I make silly mistakes. <:-}
	* tipms.tcl (generateDocument): Fix for [1203526]
	* tiptex.tcl (generateDocumentHeader): Fix for [1203525]

2005-01-12  Donal K. Fellows  <[email protected]>

	* tiprtf.tcl: Try to get a better looking document header.

2004-12-27  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (generateTIPHeader): Add explicit link to icon in
	* mail.tcl (mailform):		   ICONURL global variable
	* edit.tcl (refuseToEdit):	   (configurable).
	* tip.tcl (serveFrameset,...): 


2003-12-03  Don Porter  <[email protected]>

	* edit.tcl (isWikispam):	Fixed nasty cluster of coding errors.

2004-12-03  Donal K. Fellows  <[email protected]>

	* edit.tcl (isWikispam, attemptCommit): Code to detect attempts to
	wikispam the TIP archive and cut it off in such a way that it
	appears to have not happened.

2004-08-11  Donal K. Fellows  <[email protected]>

	* postnews.tcl (generateNewsMessage): Add quoting around email
	address real names that contain a period to work around a pair of
	bugs in mailman's email address parsing and /bin/mail's email
	address reformatting (or rather lack of it).

2004-08-09  Donal K. Fellows  <[email protected]>

	* tipmode.el (tip-font-lock-keywords, tip-header-matcher-alist):
	Allow recognition of new headers.

	* tipxml.tcl (generateDocument):	Add code to print the new
	* tiptxt.tcl (index, generateDocument): headers.
	* tiptex.tcl (generateDocumentHeader): 
	* tipms.tcl (generateDocument): 
	* tiphtml.tcl (longidx, longidx2, generateTIPHeader): 

	* parse.tcl (TIPHeaderSpecification): Add four new vote-related
	headers to record when a vote closes (or closed) and what those
	votes were.

2004-03-25  Donal K. Fellows  <[email protected]>

	* tiprtf.tcl (index, image): Added placeholders for
	non-implemented bits.

	* tip.tcl (serveFrameset, serveIndex): Added anchor to make the
	quick index frame go to the end of the TIPs, following suggestion
	by Andreas Leitgeb.

	* tiphtml.tcl (generateDocument): The RTF formatter sort-of works.
	Open it up to a bit more scrutiny by publicising it.

2004-03-24  Donal K. Fellows  <[email protected]>

	* edit.tcl (attemptCommit): Fix check for abstract so that it
	works now we have subsection parsing.

2004-03-16  Donal K. Fellows  <[email protected]>

	* parse.tcl (intuitParagraphKind): Add code to spot when to create
	subparagraphs instead of paragraphs.
	* tip{type}.tcl: Support for rendering using '''bold''' as well as
	italics.  This is an oft-requested feature.

2004-03-12  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (continuation): Modify handling of [url] style so
	that it comes out as something much shorter.  People coming from
	the TIP format expect this sort of handling.
	* parse.tcl (ItemLeadRE): Allow colons in selected places in
	headers description terms provided they are not in a bad location
	within the item, prompted by required use within TIP#173. 

2003-10-20  Donal K. Fellows  <[email protected]>

	* tiptxt.tcl (fmtPar): Minor update to text formatter so that
	browsers like Mozilla interpret emphasized text in publishing
	messages as bold instead of underline; italic would be better, but
	many things with / in are already published.

2003-08-29  Donal K. Fellows  <[email protected]>

	* tipxml.tcl: New way of handling verbatim sections avoids having
	to use a &ff; entity.  [Bug 796731]

	* base64.tcl, postnews.tcl: Factored out base-64 encoding engine.

2003-08-15  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl: Added title attributes to many links, which some
	browsers render as tooltips.  Nice!

	* tipmode.el (tip-verify-states-re): Forgot a state.  D'oh!

2003-08-13  Don Porter  <[email protected]>

	* tiphtml.tcl: Quick hack solution to have the Tcl-Version
	Header for Project TIPs displayed in the medium TIP index.

2003-02-27  Donal K. Fellows  <[email protected]>

	* tip.tcl (serveFrameset): Allowed the left frame to resize at
	request from Joe Mistachkin.

	* tiphtml.tcl, tip.tcl, config.tcl, etc.: I believe I've been
	over-zealous about quoting charsets for content types, and I've
	thrown in an extra <meta> tag into all HTML output to try to deal
	with the weirdness of some browsers. [Bug #693848]

2002-11-12  Donal K. Fellows  <[email protected]>

	* postnews.tcl: Added feature to allow directing of announcements
	to additional mailing lists (and fixed error message code!)
	following suggestion by Dan Steffen (re TIP#118)

2002-06-05  Donal K. Fellows  <[email protected]>

	* stats.bydomain.tcl: New statistics generating program to
	aggregate by domain-name.

2002-03-19  Donal K. Fellows  <[email protected]>

	* tiptex.tcl (paragraph,tipdefs): Fixed underline handling in
	\tipmail macro uses.

2002-02-20  Donal K. Fellows  <[email protected]>

	* tipmode.el (tip-font-lock-keywords): Added highlighting for '%'
	symbols in URIs.

	* mail.tcl (processmail): Added Errors-To: header.
	* postnews.tcl (generateNewsMessage): Added Errors-To: header.
	* parse.tcl (URLRE): URLs can contain '%' chars too.

2002-02-12  Donal K. Fellows  <[email protected]>

	* history.tcl: Added hiding in history.
	* mail.tcl, tiphtml.tcl: Neatened up hiding.

2002-02-11  Donal K. Fellows  <[email protected]>

	* postnews.tcl: Restructured so as to produce messages better
	suited to where they were going; stuff intended for mail gets a
	Reply-To: header, whereas stuff intended for c.l.t.a does not.
	Also generates Message-Id: header and has some code factored out
	and packaged up.
	* tiptxt.tcl (index,generateDocument): 
	* tiptex.tcl (paragraph,tipdefs): Added some @ hiding.
	* tiphtml.tcl (xformmailto,continuation,fmtauthor): 
	* mail.tcl (row,row_a,mailform,mailformaccept): More sophisticated
	hiding of @ signs.

2002-02-08  Donal K. Fellows  <[email protected]>

	* config.tcl (SENDMAILURL): 
	* mail.tcl (mailform): Added way to control which server sends the
	email message, as part of working around brokenness in the
	ActiveState server.

2002-02-05  Donal K. Fellows  <[email protected]>

	* mail.tcl (mailform): Fixed daft typo.

2002-02-04  Donal K. Fellows  <[email protected]>

	* postnews.tcl (generateNewsMessage): Another place where I made
	use of TCLCOREMAIL global.
	* conf_def.tcl, config.tcl (TCLCOREMAIL): Email address for
	tcl-core mailing list.
	* tiphtml.tcl (xformmailto,etc.): Mangle email addresses so that
	they redirect through our web interface, as part of an effort to
	deter spammers.
	* tip.tcl: Additions to support mail form.
	* mail.tcl: New file to do mail sending via web so that TIP
	authors can remain contactable even after email address mangling.

2002-02-01  Donal K. Fellows  <[email protected]>

	* post.tcl (getVars): Fixed security problem that could have
	permitted the setting of arbitrary Tcl variables to arbitrary
	values.

2002-01-24  Donal K. Fellows  <[email protected]>

	* postnews.tcl (generateNewsMessage): Removed generation of
	Reply-To header in some cases; email sucks...

2002-01-10  Donal K. Fellows  <[email protected]>

	* tipmode.el (tip-verify-headers): Now correctly verifies TIP
	headers!

2002-01-03  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (longidx2): Forgot to clear out array during output
	loop, resulting in forward propagation of optional fields.
	Reported by Bruce Hartweg <[email protected]>

2001-12-18  Donal K. Fellows  <[email protected]>

	* tip.tcl: Factored out the <!DOCTYPE> declarations into one spot
	in this file for ease of maintenance.  Note that this is not
	expected to be generally configurable since major changes could
	involve reworking large parts of several files.

2001-12-18  Don Porter  <[email protected]>

	* Added color highlights for Accepted (blue) and Deferred (green)
	TIPs.

2001-12-18  Donal K. Fellows  <[email protected]>

	* tipmode.el (tip-verify-headers): Start of some code to verify
	TIP headers prior to checkin...

	* tiphtml.tcl, tip.tcl: Added more advanced searching facilities.

2001-11-28  Donal K. Fellows  <[email protected]ac.uk>

	* tiptex.tcl (quote): Further extension of the "TeX-encoding"
	code in response to accented characters.

2001-11-05  Donal K. Fellows  <[email protected]>

	* quicktip.tcl: Little utility to convert a TIP body into an HTML
	fragment; useful both for people developing TIPs and for anyone
	wanting to write tools that generate TIP-like output.

	* config.tcl, conf_def.tcl: Added content-type information for RTF.

	* tiprtf.tcl: Added first version of TIP generator submitted by
	Juan C. Gil <mailto:[email protected]>, though it needs a lot more work.

2001-10-31  Donal K. Fellows  <[email protected]>

	* tipxml.tcl (sectype,section,stag,generateDocument): Generate
	subsections and subsubsections from suitable TIP input.
	(index): Also generate a processing instruction to indicate that
	the index parts of a TIP are special.

	* tipms.tcl: Yet more *roff improvements.

2001-10-30  Donal K. Fellows  <[email protected]>

	* tipms.tcl: Various changes to make use of *roff features better.

2001-10-02  Donal K. Fellows  <[email protected]>

	* tiptex.tcl: Now use the hyperref package which does lots more
	things right-ish and which simplifies the code in a fair number of
	places too.

2001-09-13  Donal K. Fellows  <[email protected]>

	* tiptxt.tcl (section): D'oh! Typo...

2001-09-07  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (section):
	* tipms.tcl (section):
	* tiptex.tcl (section,tipdefs,generateWholeArchive):
	* tiptxt.tcl (section):
	* tipview.tcl (section):
	* tipxml.tcl (section): Added optional level argument to support
	multiple levels of sectioning, a feature that is in discussion as
	part of supporting the move of the TIP format to something capable
	of dealing with more general documents.  Note that the LaTeX
	generator is currently incomplete in its support for multiple
	section levels (the PDF index is not yet level-split) and the
	Troff and XML generators just ignore the value and are thus plain
	wrong (the XML will need a new DTD and a substantial rewrite to
	get support for this feature.)

2001-09-04  Donal K. Fellows  <[email protected]>

	* tipmode.el (tip-check-spelling): New function for checking the
	spelling of a TIP.  Also added a menu bar entry for the various
	functions supported by the mode.

2001-08-31  Donal K. Fellows  <[email protected]>

	* tipview.tcl: A crude TIP previewer.

2001-08-30  Donal K. Fellows  <[email protected]>

	* tip.tcl: The below change broke when symlinks got involved (as
	was the case in my webserver.)  Now resolved to work better,
	though this still assumes that there aren't any symlinked
	directories in unfortunate places.

2001-08-25  Don Porter  <[email protected]>

	* cvsupdate.tcl:
	* postnews.tcl:
	* stats.bybrowser.tcl:
	* stats.byfile.tcl:
	* stats.byip.tcl:
	* tip.tcl:
	* tiparchive.tcl:  Replaced several hard-coded paths with
	portable replacements.

2001-08-24  Don Porter  <[email protected]>

	* parse.tcl (getTIPDetails): Bug fix.  When a new author was added
	when committing new revisions through the web, their changes to the
	body were lost due to a broken caching scheme in reading TIP files.
	Thanks to Jeff Hobbs for pointing out the bug.  [Bug 455134].

2001-08-22  Donal K. Fellows  <[email protected]>

	* history.tcl (difflines): Added code to untabify the output.

2001-08-16  Donal K. Fellows  <[email protected]>

	* postnews.tcl (generateNewsMessage): Now use first TIP author for
	the From: field to make it clearer who is the author of the TIP,
	as opposed to the publisher.  Much thanks to Anselm Lingnau
	<[email protected]> for his help with this.

2001-08-13  Donal K. Fellows  <[email protected]>

	* tiptex.tcl (quote,tipdefs,generateWholeArchive): Fixes to
	improve handling of some characters outside ASCII 32..126 and to
	make the state be more controlled between TIPs when creating a
	whole archive rendering.

2001-07-13  Donal K. Fellows  <[email protected]>

	* tiptex.tcl, postnews.tcl, tiparchive.tcl, config.tcl,
	* conf_def.tcl: Added features to make publishing not enabled by
	default and to support the creation of PDF files from the TIP
	archive my means of pdflatex.  TIPs published via email/news now
	have richer headers.

	* epstopdf.tcl: Added version of Sebastian Rahtz's epstopdf script
	that works as a Tcl library and handles conversion to a level
	other than whatever GhostScript thinks ought to be the default.

	* md5.tcl: Added version of Don Libes's md5pure that generates its
	output in binary form, which is necessary for generating md5
	content lines in email messages, which are base64-encoded.

2001-05-24  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (generateTIPHeader,generateDocument): 
	* history.tcl (fmtrevision,fmtlogentries): 
	* tip.tcl (serveRevision): Added ability to view individual
	versions of any TIP, selectable via a link on the document
	revision history page.

2001-05-18  Donal K. Fellows  <[email protected]>

	* tipxml.tcl (makeTextContent): 
	* tiptxt.tcl (fmtPar): 
	* tiptex.tcl (paragraph): 
	* tipms.tcl (putspar): 
	* tiphtml.tcl (continuation): Handling of doubled brackets was
	wrong, as doubling was not preventing interpretation of the
	contents as a short TIP reference.

2001-04-26  Donal K. Fellows  <[email protected]>

	* mailnote.tcl: Start of a mechanism for emailing notifications
	when a TIP is updated.  This portion to be run as a CVS loginfo
	script somehow?

2001-04-25  Donal K. Fellows  <[email protected]>

	* makeconfig.tcl: Added capability to run a script after the GUI
	is done but before writing the configuration out.

2001-04-23  Donal K. Fellows  <[email protected]>

	* makeconfig.tcl: Balloon help. In simple mode offers basic
	editing guidelines based on the field type, and in expert mode
	states the name of the variable controlled.

2001-04-20  Donal K. Fellows  <[email protected]>

	* edit.tcl (cookieHeader): Made the path parameter to Set-Cookie:
	headers into something that is separately configurable.
	* config.tcl:
	* conf_def.tcl: Added COOKIEPATH.
	* makeconfig.tcl (runGUI): Better handling of dynamically-derived
	values to better appreciate the case where one depends on another.

	* history.tcl (fmtlogentries): Hard-coded value that should never
	be changed without extensive other alterations...
	* makeconfig.tcl: Reorganized to remove app-specific stuff from
	this file, and moved configuration-specific things into a separate
	namespace.  Moved much code into procedures as well.
	* conf_def.tcl: Moved much application-specific stuff into this
	separate file from makeconfig.tcl

	* edit.tcl (presentForm): Added some words about how we are using
	cookies to help quell the paranoiacs.

2001-04-18  Donal K. Fellows  <[email protected]>

	* makeconfig.tcl: Minor improvements...

	* edit.tcl (editTIP): D'oh!  Stupid bug fixed...

	* edit.tcl (cookieHeader): Now generates correct string...  :^)

2001-04-17  Donal K. Fellows  <[email protected]>

	* edit.tcl (cookieHeader,getCookie,editTIP,attemptCommit): Added
	code to use cookies to make name/email fields persistent.

	* tip.tcl (processCGIOptions): Added code to decode cookies to a
	global 'cookie' array.

	* edit.tcl (setPOSTdefaults,presentForm,attemptCommit): Added
	ability to add info to CVS log message to form; added info is
	placed on second line onwards to discourage spoofing.

	* config.tcl: More extensive hack to keep CVS working over the web
	here; code to actually do this is not in CVS as it is a piece of
	site-specific setuid C hackery...

	* tip.tcl (serveHistory,serveDiff): Generate history/diff before
	printing anything so error message doesn't get mangled.
	* history.tcl (fmtlogentries,fmtdifflines): Changed so as to
	return the generated string, not print it.

2001-04-12  Donal K. Fellows  <[email protected]>

	* makeconfig.tcl: Script to help people configure the TIP Renderer.

2001-04-11  Donal K. Fellows  <[email protected]>

	* config.tcl (FEATURE->EDIT_URL_HTML): 
	* tiphtml.tcl (generateDocument): Improved edit url support to be
	more sensitive by allowing edit link to site that supports editing
	even if the current one does not.  Note that EDIT feature
	overrides this setting unilaterally.

2001-04-10  Donal K. Fellows  <[email protected]>

	* config.tcl: 
	* tiphtml.tcl (generateDocument): 
	* tip.tcl (serveHistory,serveDiff): 
	* history.tcl: Basic CVS history browsing code.

2001-04-09  Donal K. Fellows  <[email protected]>

	* config.tcl (TCLLOGOURL,TCLLOGOX,TCLLOGOY): 
	* tip.tcl (generr,serveSearch,basicHTMLfooter): 
	* tiphtml.tcl (generateDocument): Added Tcl-Powered logo to footer.

2001-04-03  Donal K. Fellows  <[email protected]>

	* tipms.tcl: *roff support added.
	* tiphtml.tcl (generateDocument): Made generating the bottom
	link-list a bit easier with a helper proc.

[RELEASE 1.2]

2001-03-29  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (getStyle) Factored out medium index colour choosing
	code and tweaked for popular support.

	* tip.tcl (processCGIOptions,serveSearch):
	* tiphtml.tcl (longidx): Added/enabled search capability by
	writing form generating/handling code.  CGI option parser is now
	much more flexible.

	* tiphtml.tcl (medidx): Made Withdrawn look like Rejected.
	(longidx): Added more sophisticated searcher and made detail
	sidebar more horizontally compact.
	* parse.tcl (constructTIPHeader): Handling of Keywords header was
	wrong.
	* tip.tcl, edit.tcl: Cleaned up generated HTML.

2001-03-28  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (index,medidx): Yet more sophisticated medium index
	handling; code now so large that it is split out into a separate
	procedure.  Most notably allows sorting in reverse order now too.

2001-03-26  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (index): Clever colouration of medium indices
	together with some cunning links to allow for selectable sorting
	by columns.
	* tiphtml.tcl (medcell,medhdr): Helper functions for above.
	* tip.tcl (processCGIOptions): Improved CGI query string parser.

2001-03-23  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (index): Changed a spot where I used <b> to <strong>
	which is what I meant.  Also double quoted all attributes.

2001-03-21  Donal K. Fellows  <[email protected]>

	* tip.tcl (processCGIOptions,serveIndex): 
	* tiphtml.tcl (index): Allow pattern to restrict types of TIPs
	listed in served index.

2001-03-09  Donal K. Fellows  <[email protected]>

	* tipmode.el (tip-insert-skeleton): Added function to create an
	outline TIP ready for editing.

2001-02-26  Donal K. Fellows  <[email protected]>

	* parse.tcl (URLRE): Added support for the https: protocol.

	* tiphtml.tcl (generateDocument): Changed XML-version link text.

	* parse.tcl (TIPHeaderSpecification): Better commenting.

	* tipxml.tcl (generateDocument): 
	* tiptex.tcl (index): 
	* tiptxt.tcl (index,generateDocument): 
	* tiphtml.tcl (generateTIPHeader): Better handling of
	Discussions-To: header.

2001-02-13  Donal K. Fellows  <[email protected]>

	* tipxml.tcl (verbatim): Made sure that the xml:space attribute
	was set correctly...

[RELEASE 1.1]

2001-02-09  Donal K. Fellows  <[email protected]>

	* postnews.tcl (generateNewsMessage): Used to generate Newsgroups:
	header even when not posted to USENET...

2001-02-07  Donal K. Fellows  <[email protected]>

	* tipxml.tcl (generateDocument): Oops!  Was generating unquoted
	attributes values for type and state attributes...  Many thanks to
	<[email protected]> for pointing this out.

2001-01-30  Donal K. Fellows  <[email protected]>

	* postnews.tcl: Added more selective publishing capabilities.

2001-01-29  Donal K. Fellows  <[email protected]>

	* stats.bybrowser.tcl: Simple log file analyser that aggregates
	according to browser being used.  Also summarises according to the
	class of browser being used (i.e. Netscape, IE, and the rest)

	* stats.byfile.tcl: Simple log file analyser that aggregates
	according to requested resource.

	* stats.byip.tcl: Uses more efficient sorting technique.

	* cvsupdate.tcl: New script to bring local copy of CVS-ed TIP
	archive up-to-date.

2001-01-24  Don Porter  <[email protected]>

	* edit.tcl (attemptCommit): Bug fix.  When a new author was added
	when committing new revisions, the Abstract was lost.  Oops.

	* parse.tcl (formatTIPDocument): Bug fix.  Error message
	generation referred to non-existent variable.

2001-01-24  Donal K. Fellows  <[email protected]>

	* config.tcl: 
	* postnews.tcl (generateNewsMessage): Added web-edit url header to
	published TIP.  Controlled by FEATURE(EDIT_URL_IN_NEWS_MESSAGE)

	* parse.tcl (formatTIPDocument): 
	* tiptxt.tcl (generateDocument): Added extra header capability.

2001-01-18  Donal K. Fellows  <[email protected]>

	* parse.tcl (getTIPFilenames): 
	* config.tcl (TESTINGTIP): Explicitly state the number of the TIP
	used for testing purposes as a configurable parameter.

2001-01-17  Don Porter <[email protected]>
	* parse.tcl (getTIPFilenames): Fixed a few bugs and features
	concerning the integrated web-editing features.

2001-01-15  Donal K. Fellows  <[email protected]>

	* stats.byip.tcl: Simple log file analyzer that aggregates
	according to host accessing, with all the limitations that
	implies.

2001-01-11  Donal K. Fellows  <[email protected]>

	* tiptex.tcl (image,generateLaTeXPreamble): Improved image
	handling, so that narrow images do not get made excessively
	large.

	* imwidth.tcl (epswidth,getImageWidthCore): Added support for
	getting the width of encapsulated postscript images.

	* tiphtml.tcl (generateDocument): 
	* config.tcl: Started adding CVSWeb support.

2001-01-09  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (generateDocument): Only generate an Edit link for
	  editable documents.

	* edit.tcl (setPOSTdefaults): 
	* parse.tcl (notEditable?): Factored out code.  Also a bit of
	  cleaning up of editing form HTML page.

2001-01-08  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl, tip.tcl, post.tcl, parse.tcl, edit.tcl, cvs.tcl, 
	* config.tcl: Merging changes from Don Porter for web-editing.
	  Note that you have to turn this feature on explicitly by setting
	  the appropriate member of the FEATURE array in config.tcl, since
	  it affects the behaviour of quite a lot of files.

	* postnews.tcl (generateNewsMessage): Generated message also gets
	  sent to the tcl-core mailing list and the TIP authors.

2000-12-15  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (continuation): Backed out change as it ruined HTML4
	  compatability.  Why is it so stupidly difficult to specify that
	  some "words" should be broken in some spots and without a
	  hyphen?  :^(

2000-12-14  Donal K. Fellows  <[email protected]>

	* imwidth.tcl (pngsize): Tcl8.0 doesn't support -encoding, but
	  that wasn't needed anyway.  Also fixed a stupid bug with binary
	  string parsing...  :^)

	* tiphtml.tcl (continuation,addwbr): Added support for splitting
	  long URLs so that paragraphs are filled more neatly.

2000-12-12  Donal K. Fellows  <[email protected]>

	* tip.tcl (logAccess): Added time to log.

2000-12-11  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (continuation): Trying to improve the handling of
	  email addresses...

2000-12-08  Donal K. Fellows  <[email protected]>

	* parse.tcl (URLRE): Added colon to permit matching of URLs with
	  specified ports.

2000-12-04  Donal K. Fellows  <[email protected]>

	* parse.tcl (getTIPFilenames): Stopped the code from finding the
	  experimental 10000.tip, at least in part because it fouls up the
	  LaTeX formatter.  Oh well, at least that's not an issue I'll
	  have to deal with for a while now.
	  (verifyTIPheader): Improved the parsing of dates.

2000-12-01  Donal K. Fellows  <[email protected]>

	* tipmode.el: Autoloading works better with a change to the
	  feature provided...

	* config.tcl: Factored out various global variables to separate
	  file for ease of maintenance.

	* tiptex.tcl (index,generateDocumentHeader,generateLaTeXPreamble):
	  Removed use of \verb for Version headers, instead relying on the
	  fact that they are always CVS/RCS fields, and are always
	  surrounded by dollar signs.  Eliminates a warning...

2000-11-30  Donal K. Fellows  <[email protected]>

	* tip.tcl (logAccess): Made more robust.
	  (serveIndex): Mentioned CVS access.

2000-11-27  Donal K. Fellows  <[email protected]>

	* tip.tcl: Improved "early termination by webserver" handling.

2000-11-23  Donal K. Fellows  <[email protected]>

	* tip.tcl (contenttypes variable): Added support for the .patch
	  extension as text/plain so that the TIP archive can deliver
	  patch files without needing to bodily include them in the TIP
	  itself, since that is considered reason for rejecting their
	  submission to comp.lang.tcl.announce

2000-11-22  Donal K. Fellows  <[email protected]>

	* tiptex.tcl (generateDocumentHeader): Improved keyword handling
	  here too.

	* parse.tcl (verifyTIPheader): D'oh!  Keyword handling was broken.

2000-11-21  Donal K. Fellows  <[email protected]>

	* tipmode.el (tip-mode-map): Added some functions for inserting
	  various constructs - sections, images, indices and verbatim
	  regions - into a TIP.

2000-11-20  Donal K. Fellows  <[email protected]>

	* tipmode.el: Fixed minor problem with header highlight regexps
	  that caused problems when you had empty headers, such as might
	  happen during development or with the Post-History: header.

2000-11-17  Donal K. Fellows  <[email protected]>

	* tipmode.el: Improved support for other people's use and removed
	  a stupid font-definition bug.

2000-11-15  Donal K. Fellows  <[email protected]>

	* tip.tcl (logAccess): Improved the logging format.

	* tipmode.el:  D'oh!  Forgot to close some parentheses.  You know
	  how LISP is.  Also improved some of the fontifying regexps...

	* tip.tcl (logAccess): Added basic logging.

	* tipmode.el: Created.

	* tiptex.tcl (image): Added warning to users to remind them to
	  acquire the relevant images from the repository.

2000-11-10  Donal K. Fellows  <[email protected]>

	* postnews.tcl (generateNewsMessage):  D'oh!  Keywords should be
	  comma-separated...

2000-11-08  Donal K. Fellows  <[email protected]>

	* parse.tcl: Changed some paths used during testing.

	* postnews.tcl (generateNewsMessage): Better handling of Subject:
	  line.  Can now specify additional text like "UPDATED:"...

2000-11-06  Donal K. Fellows  <[email protected]>

	* tiptex.tcl (generateWholeArchive): Added colophon with advert
	  for ourselves...  :^)

	* parse.tcl: Can test-generate XML now.

	* tiphtml.tcl (generateDocument): Footer now refers to XML
	  generator as well.

	* tipxml.tcl: NEW!  The file that supports generating XML from
	  TIPs.

	* tip.tcl: Pointed SRCDIR to the proper place.  Added XML/DTD
	  support to MIME type array.

	* tiparchive.tcl: Pointed SRCDIR to the proper place.

2000-11-03  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (verbatim): They didn't show up here either.

	* tiptex.tcl (verbatim): Verbatim formfeeds no longer choke LaTeX.

	* tiphtml.tcl (image): Adjusted to switch scaling behaviours at a
	  larger image width, and for images to be scaled to a larger
	  size.

	* tiptex.tcl (generateWholeArchive,generateLaTeXPreamble):
	  Improved handling of title, and document date is now left
	  unspecified so that packages like babel can do it for
	  themselves, if asked.
	  (generateDocRefs) Slightly better expression of references.
	  Also adds a line to the table of contents, and reports it as
	  References instead of Bibliography, so fixing a peculiarity of
	  the standard report class.
	  (paragraph,quote) Cleaned up some of the regexps, and added some
	  support for numeric-range dashes.

2000-11-02  Donal K. Fellows  <[email protected]>

	* tiphtml.tcl (image): Improved support for wide images by making
	  them into links to the unscaled version when scaling is used at
	  all.

2000-10-30  Donal K. Fellows  <[email protected]>

	* tiptex.tcl (image): Somewhat improved handling of scaled images.

	* tiptex.tcl (generateDocumentHeader): Had to move abstract
	  formatting out to stop massive wasting of space.
	  (generateLaTeXPreamble) Added support for document class
	  selection since when formatting the whole archive, it is not
	  good enough to use article.cls

	* tiparchive.tcl: A simple script driver file for the below
	  procedure.

	* tiptex.tcl (generateWholeArchive): New procedure to format the
	  whole TIP archive as a single LaTeX doc.

	* postnews.tcl: Changed to send mail to the comp.lang.tcl.announce
	  moderator instead of using the posting mechanism, as that seems
	  somewhat dodgy on my system at the moment.

	* postnews.tcl (generateNewsMessage): Added From: field.

2000-10-27  Donal K. Fellows  <[email protected]>

	* postnews.tcl: D'oh!  A debugging "echo" was stopping this script
	  from working.  Sometimes you just feel so stupid...

	* tiptex.tcl (paragraph): Removed bug in handling of tilde
	  and ampersand characters in URLs.
	  (generateLaTeXPreamble,generateDocumentHeader,generateDocRefs)
	  Factorized these out from generateDocument to make the writing
	  of a script that formats the whole collection as a single paper
	  document a bit easier.

	* tiphtml.tcl (generateDocument): Added hyperlink support for the
	  Discussions-To header.

	* parse.tcl (URLRE): Hmph. Needed to expand this to take into
	  account the actual characters being used in real TIPs.  *sigh*

	* tiptex.tcl (generateDocument): Adjusted to use tabularx for the
	  main header.  This makes working out the correct size of the
	  table absolutely trivial, unlike before where I just put in a
	  value that happened to work for me...

2000-10-26  Donal K. Fellows  <[email protected]>

	* postnews.tcl: New file.  Script that automates the posting of
	  TIPs to comp.lang.tcl and comp.lang.tcl.announce.

	* tiptxt.tcl (generateDocument): Now generates an additional URL
	  header which refers to the HTML version.

	* tiptex.tcl (paragraph,generateDocument): Made the references to
	  other TIPs be done using the bibliographic citation mechanism
	  when formatting for LaTeX.

[RELEASE 1.0]

2000-10-25  Donal K. Fellows  <[email protected]>

	* New version released by CVS.  This has resulted in several
	  files being deleted and several being added.

2000-09-25  Donal K. Fellows  <[email protected]>

	* Released via CVS.

Added README.










































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
TIP Rendering Engine
~~~~~~~~~~~~~~~~~~~~

A  CGI script  to render  TIPs into  other formatting  languages (like
HTML, LaTeX, Plain Text, XML, etc.

License
~~~~~~~

Copyright (c) 2000 Donal K. Fellows

This  software is  provided 'as-is',  without any  express  or implied
warranty. In no event will the  authors be held liable for any damages
arising from the use of this software.

Permission is granted to anyone  to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:

  1. The origin of this software  must not be misrepresented; you must
     not claim that you wrote  the original software.  If you use this
     software  in   a  product,  an  acknowledgment   in  the  product
     documentation would be appreciated but is not required.

  2. Altered source versions must be  plainly marked as such, and must
     not be misrepresented as being the original software.

  3. This  notice  may not  be  removed  or  altered from  any  source
     distribution.

Using
~~~~~

As a CGI script:
    Modify tip.tcl to suit your local setup (in particular, to tell it
    where your  local TIP  archive is!) and  you'll be ready  to roll.
    All you need  to do at this point is to  make your webserver start
    it in  response to the  right CGI request.   Note that due  to the
    peculiarities of how the script behaves, it looks like a directory
    in use, so  you are probably better off installing  it so that the
    script is named without an extension...

Stand-alone:
    Modify parse.tcl to suit your  local setup (in particular, to tell
    it where your local TIP archive  is!) and you'll be ready to roll.
    All you need to  do then is run parse.tcl and give  it the name of
    the file you want it to generate (in the form tipnumber.extension)
    in the current directory.  You  can specify extra packages for the
    LaTeX  formatter  to   use  using  the  LATEXPACKAGES  environment
    variable (as a comma-separated list) and extra (global) options to
    the  packages  using  the  LATEXOPTS environment  variable  (as  a
    comma-separated list.)

For generating TIP Editor messages to comp.lang.tcl.announce:
    Modify postnews.tcl  to suit your  local setup, and then  call the
    script with a single argument: the number of the TIP to format (as
    plain text) and  send a notification on USENET  about.  DO NOT USE
    THIS SCRIPT IF YOU ARE NOT THE TIP EDITOR!

For generating the whole TIP archive as a single LaTeX2e document:
    Modify tiparchive.tcl to suit your local setup, and then call with
    no arguments.  The  output is generated on standard  out.  You can
    specify extra  packages for the  LaTeX formatter to use  using the
    LATEXPACKAGES environment variable (as a comma-separated list) and
    extra  (global)  options  to  the  packages  using  the  LATEXOPTS
    environment variable (as a comma-separated list.)


Donal K. Fellows.  25th October, 2000

Added base64.tcl.
































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
proc B64encode {str {len -1}} {
    set base64digits \
	    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    binary scan $str B* bits
    if {$len < 0} {
	set len [string length $bits]
    }
    set result {}
    for {set i 0} {$i<$len} {incr i 6} {
	binary scan [binary format B8 \
		00[string range $bits $i [expr {$i+5}]]0000] c mybits
	append result [string index $base64digits $mybits]
    }
    while {[string length $result] % 4} {append result =}
    return $result
}

Added conf_def.tcl.






























































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
### GENERAL CONFIGURATION OF THE CONFIGURATION CODE ###

namespace eval configure {

    # For each value that this file describes how to configure...
    #
    #   var_name var_type default_value documentation_string
    #
    # The default values will be [subst]ed before assignment, and this
    # operation will be applied in order to the variables.
    variable variables {
	DOCDIR      dir    {}     \
		"Path to directory containing TIP archive checked out of CVS"
	EDITDIR     dir    {}     "Path to directory to use for web editing"
	BASETARG    string _self  "Name of target window for links in HTML"
	BASEURL     string {}     \
		"URL which CGI script will operate as, with trailing '/'"
	CSSURL      string http://www.cs.man.ac.uk/~fellowsd/std.css \
		"URL for style sheet to apply to HTML"
	ICONURL	    string http://www.tcl.tk/favicon.ico \
		"URL for link icon to apply to all HTML documents"
	ENGINEURL   string http://sourceforge.net/projects/tiprender/ \
		"URL for TIP Renderer project on SourceForge"
	TCLLOGOURL  string http://tcl.sourceforge.net/images/tclp.gif \
		"URL of Tcl logo image"
	TCLLOGOX    number 42     "Horizontal size of Tcl logo image"
	TCLLOGOY    number 64     "Vertical size of Tcl logo image"
	TCLCOREMAIL string [email protected] \
		"General email address for correspondence w.r.t. TIP contents"
	FOOTERTEXT  string "TIP AutoGenerator - written by Donal K. Fellows" \
		"Text footer of formatted pages; not HTML, must be HTML-safe"
	LOGFILE     file   {}     \
		"Path to log file (must be writable by CGI script)"
	CVS_CLIENT  file   {[locateBinary cvs      /usr/bin/cvs]} \
		"Path to cvs client binary"
	SENDMAIL    file   {[locateBinary sendmail /usr/lib/sendmail]} \
		"Path to sendmail (or compatible) binary"
	GS	    file   {[locateBinary gs       /usr/bin/gs]} \
		"Path to ghostscript binary"
	PDFLATEX    file   {[locateBinary pdflatex /usr/bin/pdflatex]} \
		"Path to PDFLaTeX binary"
	PUBLISHURL  string http://purl.org/tcl/tip \
		"Base URL for publishing"
	EDITURLBASE string http://purl.org/tcl/tip/edit \
		"Base URL for web editing"
	CVSWEBURL   string {[set BASEURL]history/%d} \
		"URL for cvsweb access; passed through format"
	SENDMAILURL string {[set BASEURL]sendmail.html} \
		"URL for web-to-mail form to target"
	TESTINGTIP  number 10000  "Number of TIP used for testing"
	ISSUEBASE   string {https://sourceforge.net/support/tracker.php?aid=}\
		"(Partial) URL for where to look up bugs/patches"

	FEATURE(EDIT)          boolean 0 "Support web editing"
	COOKIEPATH  string {[pathComponent $BASEURL /]} \
		"Path control value for cookies generated, with trailing '/'"
	FEATURE(CVSWEB)        boolean 1 "Support history inspection"
	FEATURE(EDIT_URL_IN_NEWS_MESSAGE) boolean 1 \
		"Put edit URL in published news msgs"
	FEATURE(EDIT_URL_HTML) boolean 1 "Put edit URL in HTML page"
	FEATURE(PUBLISHING)    boolean 0 \
		"Can publish announcements of new TIPs"

	history::infobg colour #80ff80 "Colour of log entries"
	history::logbg  colour #b0d0ff "Colour of history details"
	history::addbg  colour #80ff80 "Colour of added lines"
	history::delbg  colour #ffa0a0 "Colour of deleted lines"
    }


    # Which values are optional (configurable only if the -expert option is
    # passed to makeconfig.tcl) as the defaults are typically good enough.
    variable optional {
	BASETARG CSSURL ICONURL ENGINEURL TCLLOGOURL TCLLOGOX TCLLOGOY
	FOOTERTEXT ISSUEBASE
	PUBLISHURL EDITURLBASE CVSWEBURL TESTINGTIP COOKIEPATH TCLCOREMAIL
	FEATURE(EDIT) FEATURE(EDIT_URL_IN_NEWS_MESSAGE) FEATURE(PUBLISHING)
	history::logbg history::infobg history::addbg history::delbg
	SENDMAILURL
    }


    # Organize the values into pages (using a list of lists). The first
    # element of each sublist is the title of the page/window, and the other
    # elements are the variables to configure on that page. Note that the
    # first page should usually be written pretty much as-is and the empty
    # "variable" is actually not a variable at all but rather a way of putting
    # a message up (its kind is always message) with the content of the
    # message taken from the introMessage variable (below.)
    # 
    # If the first variable on a page is optional, the whole page is optional.
    variable pages {
	{
	    "Configuring TIP Renderer"
	    ""
	}
	{
	    "Basic Locations"
	    DOCDIR EDITDIR BASEURL TCLCOREMAIL
	}
	{
	    "Self Advertising"
	    BASETARG CSSURL ICONURL ENGINEURL FOOTERTEXT TESTINGTIP
	}
	{
	    "Tcl Powered Logo"
	    TCLLOGOURL TCLLOGOX TCLLOGOY
	}
	{
	    "Editing Features"
	    EDITURLBASE CVSWEBURL FEATURE(EDIT) COOKIEPATH
	}
	{
	    "Publishing Features"
	    FEATURE(PUBLISHING) PUBLISHURL FEATURE(EDIT_URL_IN_NEWS_MESSAGE)
	}
	{
	    "Advanced Reporting"
	    FEATURE(CVSWEB) FEATURE(EDIT_URL_HTML)
	}
	{
	    "CVS-Web Colours"
	    history::infobg history::logbg history::addbg history::delbg
	}
	{
	    "Mail Control"
	    SENDMAILURL TCLCOREEMAIL
	}
	{
	    "Executables and Logs"
	    CVS_CLIENT SENDMAIL GS PDFLATEX LOGFILE
	}
    }


    # Introductory message for the first page that the user sees. Should
    # mention the -expert option and any other options that you define.
    variable introMessage "Welcome to the TIP Rendering engine configuration\
	    wizard. Please supply a value for all empty fields and check\
	    that all other fields are set to sensible values. Many more\
	    fields are available to edit if you start this script with the\
	    -expert option. Once you have chosen values for everything,\
	    this script will write a suitable config.tcl for you into the\
	    current directory."


    # String to write at the front of the configuration file. Contains bits
    # that are needed always (typically things that are only ever configured
    # by the code author). Leading whitespace from each line will be
    # stripped...
    variable header {
	# Both $DOCDIR and $EDITDIR should be working directories checked out
	# from the same CVS repository if web-editing is enabled. The CGI
	# process needs write access to $EDITDIR, and commit privileges to
	# CVS. $DOCDIR must be configured to receive updates each time a
	# change is committed.
	# (See Appendix C, Section C.7.2 of the CVS manual).

	set URI ???
	namespace eval ::history {}

	array set contenttypes {
	    .tip   "text/x-tcl-tip; charset=iso-8859-1"
	    .html  "text/html; charset=iso-8859-1"
	    .htm   "text/html; charset=iso-8859-1"
	    .txt   "text/plain; charset=iso-8859-1"
	    .patch "text/plain; charset=iso-8859-1"
	    .tex   "application/x-latex; charset=iso-8859-1"
	    .xml   "text/xml; charset=iso-8859-1"
	    .gif   "image/gif"
	    .jpg   "image/jpeg"
	    .jpeg  "image/jpeg"
	    .jpe   "image/jpeg"
	    .png   "image/png"
	    .ppm   "image/x-portable-pixmap"
	    .ps    "application/postscript"
	    .eps   "application/postscript"
	    .fig   "application/x-fig"
	    .tcl   "application/x-tcl; charset=iso-8859-1"
	    .dtd   "application/xml-dtd; charset=iso-8859-1"
	    .xml   "text/xml; charset=iso-8859-1"
	    .ms    "application/x-troff; charset=iso-8859-1"
	    .rtf   "text/rtf; charset=iso-8859-1"
	}

	set renderable {}
	set renderexts {}
	foreach ext [array names contenttypes] {
	    if {[file exists $SRCDIR/tip[string trim $ext .].tcl]} {
		lappend renderable $ext
		lappend renderexts [string trim $ext .]
	    }
	}
    }

    catch {
	if {[string match *Name:*.cs.man.ac.uk* \
		[exec nslookup [info hostname]]]} {
	    append header {
		### UGLY HACK ALERT!  Fix access to suitable .cvspass file ###
		set ::env(HOME) $SRCDIR/cvshack
		if {[catch {exec $SRCDIR/cvshack/fix} msg]} {
		    puts "Content-Type: text/plain\n\nERROR: $msg"
		    exit
		}
	    }
	}
    }
}

### CODE THAT IS NEEDED FOR THIS PARTICULAR CONFIGURATION ###

# Procedure to derive proper command paths from the name of the command and
# the current path (UNIX-specific.)
proc locateBinary {name fallback} {
    global env
    set pwd [pwd]
    foreach dir [split $env(PATH) ":"] {
	set fn [file join $pwd $dir $name]
	if {[file isfile $fn] && [file executable $fn]} {
	    return $fn
	}
    }
    return $fallback
}

# Procedure to extract the path part of a URL.
proc pathComponent {url fallback} {
    if {[regexp {^[^/]+//[^/]+(/.*)$} $url -> path]} {
	return $path
    }
    return $fallback
}

# Hack to make sure that setting variables directly into namespaces works...
namespace eval ::history {}

# I like greys, and this undoes all sorts of CDE nastiness...
tk_setPalette grey85

Added config.tcl.




























































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
# Points into local copy of CVS archive
set DOCDIR	/home/fellowsd/lang/tcl/tip

# Both $DOCDIR and $EDITDIR should be working directories checked out
# from the same CVS repository.  The CGI process needs write access
# to $EDITDIR, and commit privileges to CVS.  $DOCDIR must be
# configured to receive updates each time a change is committed.
# (See Appendix C, Section C.7.2 of the CVS manual).
##set DOCDIR     $SRCDIR/tips
set EDITDIR	$SRCDIR/tipedit

set BASETARG	_self
set BASEURL	http://www.cs.man.ac.uk/fellowsd-bin/TIP/
set CSSURL	http://www.cs.man.ac.uk/~fellowsd/std.css
set ICONURL	http://www.tcl.tk/favicon.ico
set ENGINEURL	http://sourceforge.net/projects/tiprender/
set TCLLOGOURL	http://tcl.sourceforge.net/images/tclp.gif
# Size of image at above URL
set TCLLOGOX	42
set TCLLOGOY	64
set FOOTERTEXT	"TIP AutoGenerator - written by Donal K. Fellows"
set URI		???
set LOGFILE	/home/fellowsd/lang/tcl/TIP/log
### More complex because I want to run on several platforms at once!
switch $tcl_platform(os) {
    SunOS {
	set CVS_CLIENT	/home/fellowsd/arch/sparc-sun-solaris/bin/cvs
	set SENDMAIL	/usr/lib/sendmail
	set GS		/opt/cs/bin/gs
	set PDFLATEX	/opt/cs/bin/pdflatex
    }
    Linux {
	set CVS_CLIENT	/usr/bin/cvs
	set SENDMAIL	/usr/sbin/sendmail
	set GS		/usr/bin/gs
	set PDFLATEX	/usr/bin/pdflatex
    }
}
# Separate, since might be a PURL
set PUBLISHURL  http://purl.org/tcl/tip
# Separate, since might not reside on same server.
set EDITURLBASE	http://purl.org/tcl/tip/edit
set CVSWEBURL	${BASEURL}history/%d
set TESTINGTIP	10000
set COOKIEPATH	/fellowsd-bin/TIP/
set TCLCOREMAIL [email protected]
set SENDMAILURL http://www.cs.man.ac.uk/fellowsd-bin/TIP/sendmail.html
set ISSUEBASE	https://sourceforge.net/support/tracker.php?aid=

array set FEATURE {
    EDIT 0
    CVSWEB 1
    EDIT_URL_IN_NEWS_MESSAGE 1
    EDIT_URL_HTML 1
    PUBLISHING 1
}

### UGLY HACK ALERT!  Gives access to suitable .cvspass file ###
set ::env(HOME) $SRCDIR/cvshack
set msg {}
foreach exe [list fix_$tcl_platform(machine)_$tcl_platform(os) fix] {
    if {![catch {exec $SRCDIR/cvshack/$exe} msg]} {
	break
    }
}
if {[string length $msg]} {
    puts "Content-Type: text/plain\n\nERROR: $msg"
    exit
}

namespace eval history {
    # Assorted configurable parameters for the history management mechanism.
    variable cmpurl compare
    variable logbg  #b0d0ff
    variable infobg #80ff80
    variable addbg  #80ff80
    variable delbg  #ffa0a0
}
array set contenttypes {
    .tip   "text/x-tcl-tip; charset=iso-8859-1"
    .html  "text/html; charset=iso-8859-1"
    .htm   "text/html; charset=iso-8859-1"
    .txt   "text/plain; charset=iso-8859-1"
    .patch "text/plain; charset=iso-8859-1"
    .tex   "application/x-latex; charset=iso-8859-1"
    .xml   "text/xml; charset=iso-8859-1"
    .gif   "image/gif"
    .jpg   "image/jpeg"
    .jpeg  "image/jpeg"
    .jpe   "image/jpeg"
    .png   "image/png"
    .ppm   "image/x-portable-pixmap"
    .ps    "application/postscript"
    .eps   "application/postscript"
    .fig   "application/x-fig"
    .tcl   "application/x-tcl; charset=iso-8859-1"
    .dtd   "application/xml-dtd; charset=iso-8859-1"
    .xml   "text/xml; charset=iso-8859-1"
    .ms    "application/x-troff; charset=iso-8859-1"
    .rtf   "text/rtf; charset=iso-8859-1"
}

set renderable {}
set renderexts {}
foreach ext [array names contenttypes] {
    if {[file exists $SRCDIR/tip[string trim $ext .].tcl]} {
	lappend renderable $ext
	lappend renderexts [string trim $ext .]
    }
}

Added cvs.tcl.






































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
# FILE: cvs.tcl
#
# Routines that interface to the CVS client program and manage file locks

proc acquireLock {tip} {
    global EDITDIR

    # Write our lock file -- overwrite any left by prior owners of our pid
    set lockFile      [file join $EDITDIR .$tip.lock]
    set myLockFile    [file join $EDITDIR .$tip.[pid].lock]
    set myReleaseFile [file join $EDITDIR .$tip.[pid].release]
    file delete -- $myReleaseFile
    set f [open $myLockFile w]
    puts $f $myReleaseFile
    close $f

    set tries 30
    while {[incr tries -1]} {
	# Try to claim the lock by renaming our lock file to the lock
	# file for the TIP we want to lock.  Only one process can win
	# this race.
	if {![catch {file rename -- $myLockFile $lockFile}]} {

	    # Here we might try setting up child process to release
	    # the lock in case we are killed before we release it.
	    # (CGI spec allows the CGI script to be killed at any time.)

	    # We got the lock!  acquireLock can return
	    return
	}

	# Someone else holds the lock.  Read it.
	set f [open $lockFile]
	set releaseFile [gets $f]
	close $f
        # How old is it?
	if {![catch {file mtime $lockFile} lockTime]
		&& ([clock seconds] - $lockTime) > 120} {
	    # The lock is more than 5 minutes old.  Assume that
	    # the process that acquired the lock died without
	    # releasing it.  We'll release it instead.
	    #
	    # Release the lock file by renaming it so that only
	    # one process can succeed in releasing it.
	    catch {file rename -- $lockFile $releaseFile}
	}

	# Wait a couple seconds, then try again to acquire the lock.
	after 2000
    }

    # After several tries, we never acquired the lock
    file delete -- $myLockFile
    return -code error "could not acquire lock"
}

proc releaseLock {tip} {
    global EDITDIR
    set lockFile [file join $EDITDIR .$tip.lock]

    # If a child process was launched as a safeguard to release
    # our lock, cancel it.

    # Release my lock.
    file delete -- $lockFile
}

proc cvs {args} {
    global EDITDIR CVS_CLIENT errorCode

    if {[catch {
	cd $EDITDIR
	uplevel 1 [linsert $args 0 exec $CVS_CLIENT -q]
    } result]} {
	# CVS writes lots of messages to stderr.  Don't treat those
	# messages as errors.  Only raise an error on a non-zero exit
	# status.
	if {[string match CHILDSTATUS [lindex $errorCode 0]]} {
	    return -code error "$result (exit code was [lindex $errorCode 2])"
	}
    }
    return $result
}

Added cvsupdate.tcl.


























>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
#! /bin/sh

# Brings local copy of CVS archive up-to-date.				\
exec /home/fellowsd/arch/sparc-sun-solaris/bin/tclsh8.0 "$0" -- ${1+"[email protected]"}

set SRCDIR [file join [pwd] [file dirname [info script]]]
source $SRCDIR/config.tcl
set EDITDIR $DOCDIR
source $SRCDIR/cvs.tcl

set code [catch {cvs -z9 update} msg]
if {[string length [string trim $msg]]} {puts $msg}
exit $code

Added edit.tcl.




































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
# FILE: edit.tcl
#
# Routines to manage the editing of a TIP via the web.

proc setPOSTdefaults {array} {
    global SRCDIR
    upvar 1 $array h

    # When is the TIP available for editing through the web?
    #    If the State is Draft, and the vote is still pending.
    # Might adjust these conditions to taste...
    if {[notEditable? h]} {
	refuseToEdit h
    }
    if {![info exists ::post::operation]} {
	source $SRCDIR/post.tcl
    }

    if {![info exists ::post::revision]} {
	regexp {^\$([^:]+): (.*)\$$} $h(Version) -> keyword expansion
	switch [string tolower $keyword] {
	    id {
		regexp {tip,v ([0-9.]+)} $expansion -> ::post::revision
	    }
	    revision {
		set ::post::revision [string trim $expansion]
	    }
	    default {
		return -code error "Header field Version: must be\
			a CVS keyword expansion of Revision: or Id:"
	    }
	}
    }

    if {![info exists ::post::abstract]} {
	set ::post::abstract $h(RawAbstract)
    }
    if {![info exists ::post::body]} {
	set ::post::body [join $h(Body) \n\n]
    }
    if {![info exists ::post::log]} {
	set ::post::log {}
    }
}

proc cookieHeader {key value} {
    global EDITURLBASE COOKIEPATH
    binary scan $value H* hexvalue
    return "Set-Cookie: $key=$hexvalue; path=$COOKIEPATH;\
	    expires=Sunday, 01-Jan-2034 00:00:00 GMT"
    # Expires line is extracted from Netscrape cookie documentation...
}
proc getCookie {key} {
    global cookie
    set value {}
    catch {
	# Fails if malformatted or non-existant, but that's OK
	set value [binary format H* $cookie($key)]
    }
    return $value
}

proc editTIP {id} {
    global DOCDIR URI 

    set filename [file join $DOCDIR $id.tip]
    if {![file readable $filename]} {
	generr "Not Found" "that document is not available on this server."
    }

    array set details [getTIPDetails $filename]
    setPOSTdefaults details
    switch -exact -- $::post::operation {
	edit {
	    if {![string length $::post::email]} {
		set ::post::email [getCookie tipwebEMAIL]
	    }
	    if {![string length $::post::name]} {
		set ::post::name [getCookie tipwebNAME]
	    }
	    presentForm details
	}
	commit {
	    attemptCommit details
	}
	default {
	    generr "Invalid Request" "the request POST for URL $URI provided\
		invalid value '$::post::operation' for form variable\
		'operation'." {} 403
	}
    }
}

proc refuseToEdit {array} {
    global BASEURL CSSURL ICONURL FOOTERTEXT
    upvar 1 $array h

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"\
            \"http://www.w3.org/TR/REC-html40/loose.dtd\">"
    puts "<html><head><title>TIP #$h(TIP): Editing Refused</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"\
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    puts "<h1>TIP #$h(TIP): $h(Title)</h1><hr>"

    puts -nonewline "<p align=\"justify\">TIP #$h(TIP) may not be edited\
	    through the web because "
    if {[string match "In progress" $h(Vote)]} {
	puts "a vote is in progress.</p>"
    } else {
	puts "its State is $h(State).</p>"
    }
    puts "<p align=\"justify\">View the current revision of \
	    <a href=\"$BASEURL/$h(TIP).html\">TIP #$h(TIP)</a>.</p>"
    puts "<hr><address>$FOOTERTEXT</address></body></html>"
    exit
}

proc presentForm {array {msg ""}} {
    global SRCDIR BASEURL FOOTERTEXT ENGINEURL
    upvar 1 $array h
    variable ::post::abstract
    variable ::post::revision
    variable ::post::body
    variable ::post::email
    variable ::post::name
    variable ::post::log

    puts "Content-Type: text/html; charset=iso-8859-1\n"
    source $SRCDIR/tiphtml.tcl
    tiphtml::generateTIPHeader [array get h]
    if {[string length $msg]} {
	puts "<p align=\"justify\"><font\
		color=\"red\"><strong>$msg</strong></font>"
    }
    puts "<p align=\"justify\">Please enter your e-mail address (required),\
	    your name (optional), make your edits to this TIP and its\
	    Abstract, and <strong>Submit</strong> them.  See <a\
	    href=\"3.html\">TIP 3</A> for a description of the TIP\
	    format.</p>"
    puts "<p align=\"justify\"><strong>You are advised to copy the text of\
	    the TIP into an editor, make your edits there, and then paste\
	    back.</strong></p>"
    puts "<form method=\"POST\" action=\"edit/$h(TIP)\"><table>"
    puts "<tr><td align=\"right\"><strong>E-mail:</strong></td><td>"
    puts "<input size=\"40\" name=\"email\" value=\"$email\">"
    puts "</td><td align=\"center\"><input type=\"reset\" name=\"reset\"\
	    value=\"Reset\"></td></tr><tr><td\
	    align=\"right\"><strong>Name:</strong></td><td>"
    puts "<input size=\"40\" name=\"name\" value=\"$name\">"
    puts "</td><td align=\"center\"><input type=\"submit\" name=\"submit\"\
	    value=\"Submit\"></td></tr></table><br><table><tr><td\
	    valign=\"top\"><strong>Abstract:</strong></td><td valign=\"top\">"
    puts "<textarea cols=\"72\" rows=\"4\"\
	    name=\"abstract\">$abstract</textarea>"
    puts "</td></tr><tr><td valign=\"top\"><strong>Body:</strong></td><td>"
    puts "<textarea cols=\"72\" rows=\"25\" name=\"body\">$body</textarea>"
    puts "<input type=\"hidden\" name=\"revision\" value=\"$revision\"><input\
	    type=\"hidden\" name=\"operation\"\
	    value=\"commit\"></td></tr>"
    puts "<tr><td valign=\"top\"><strong>Log:</strong></td><td\
	    valign=\"top\"><textarea cols=\"72\" rows=\"2\"\
	    name=\"log\">$log</textarea><p><em>This is a supplement to the\
	    main log message to allow you to add extra notes if you\
	    wish.</em></p></td></tr>"
    puts "</table></form><p align=\"justify\"><font size=\"1\">Note that\
	    when you submit this form, the server will attempt to store\
	    your personal details (<i>i.e.</i> name and email address) as\
	    cookies in your browser so that next time you edit a TIP, you\
	    do not need to retype this info. We do not retain the information\
	    on our server (other than as logged in the TIP itself and in\
	    the CVS log) and you can delete it without ill-effect if you\
	    wish. <a href=\"$ENGINEURL\">You are invited to study the\
	    implementation code</a> if you wish to understand exactly how\
	    the information is stored in your browser.</font></p><hr\
	    ><address>$FOOTERTEXT</address></body></html>"
    exit
}

proc attemptCommit {array} {
    global EmailRE EDITDIR BASEURL SRCDIR DOCDIR
    upvar 1 $array h

    if {![regexp $EmailRE <$::post::email>]} {
	presentForm h "You must provide a valid e-mail address!"
    }

    set pars [splitIntoParagraphs [string trim $::post::body]]

    # Force Abstract into a single paragraph and heading and stick
    # it at the beginning.
    set pars [linsert $pars 0 "~ Abstract" [join [splitIntoParagraphs \
	    [string trim $::post::abstract]] \n]]

    # Double-check we did that right...
    if {[string compare {section Abstract 1} \
	    [intuitParagraphKind [lindex $pars 0]]]} {
	presentForm h "Each TIP must begin with an Abstract!"
    }

    # For wiki-spam, we adopt an evil approach; we pretend that we've
    # successfully checked in the change but in fact we've done
    # nothing of the sort and just format the page that the user
    # submitted so that it appears they were successful.
    if {[isWikispam h $pars]} {
	global COOKIEPATH
	array set oldHeaders [getTIPDetails $DOCDIR/$h(TIP).tip]
	set oldHeaders(Post-History) \
		"<span style=\"foreground:red\">Wikispam detected: $why</span>\
		Contact <a href=\"mailto:[email protected]>the\
		TIP Editor</a> for help, including the change this TIP."
	set ohpar [constructTIPHeader [array get oldHeaders]]
	set data [formatTIPDocument $ohpar\n\n[join $pars \n\n]]
	puts "Content-Type: text/html"
	puts "Content-Length: [string length $data]"
	puts [cookieHeader chongqid $::post::name]
	puts ""
	puts -nonewline $data
	exit
    }

    # Remove any CVS keyword expansion from the new TIP body to avoid
    # conflict false alarms.
    #
    # At this point we could do any additional consistency or format
    # checking on the new TIP body, and return bad TIPs to submitter
    # for more editing.
    #
    set newBody [join $pars \n\n]
    foreach keyword [list Author Date Header Id Name Locker Log RCSfile \
	    Revision Source State] {
	regsub -all -- \\$$keyword:?.*\\$ $newBody $$keyword$ newBody
    }

    # Change to the working directory for editing, so cvs commands
    # will work, and filenames can be relative.
    cd $EDITDIR

    # OK, now comes the tricky part.  We need exclusive access to the
    # .tip file in $EDITDIR so we can update, merge, and commit the new
    # changes in the TIP without interference from other CGI processes
    # trying to do the same thing.  So, we use a locking mechanism.
    # See cvs.tcl for details.
    source $SRCDIR/cvs.tcl
    
    # The next command will block until it can aquire the lock it needs.
    if {[catch {acquireLock $h(TIP)}]} {
	presentForm h "Could not acquire a lock on a working copy of\
		$h(TIP).tip.  Please wait a moment and try your\
		submission again."
    }

    # Retrieve from CVS the revision on which the new edits are based.
    set file $h(TIP).tip
    file delete -- $file
    cvs update -r $::post::revision -kk $file

    # Replace the old body with the new body.  Keep the old headers so we
    # avoid any merging conflicts in the headers.
#    set newTIP [constructTIPHeader [getTIPDetails $file]]\n\n[join $pars \n\n]
    set newTIP [constructTIPHeader [getTIPDetails $file]]\n\n$newBody
    file delete -- $file
    set f [open $file w]
    puts $f $newTIP
    close $f

    # Merge in the other changes from the HEAD revision.  Record whether
    # there was a conflict, and read in the merged result.
    set conflict [string match "*C $file*" [cvs update -A -kk $file]]
    array set details [array get h]
    array set details [getTIPDetails $file]

    # Add submitter as a new Author in headers, if necessary
    set newAuthor 1
    foreach author $details(Author) {
	if {[string match *<$::post::email>* $author]} {
	    set newAuthor 0
	    break
	}
    }
    if $newAuthor {
	lappend details(Author) "$::post::name <$::post::email>"
	set newTIP [constructTIPHeader [array get details]]
	append newTIP "\n\n~ Abstract\n\n$details(RawAbstract)"
	append newTIP \n\n[join $details(Body) \n\n]
	file delete -- $file
	set f [open $file w]
	puts $f $newTIP
	close $f
    }

    if {$conflict} {
	regexp {revision:[ \t]*([0-9.]+)} [cvs status $file] -> ::post::revision

	# After releasing the lock, send a form back to
	# submitter to resolve the conflict.
	set postReleaseScript {
	    unset ::post::abstract
	    unset ::post::body
	    setPOSTdefaults details
	    presentForm details "Your changes conflicted with changes from\
		    someone else.  Please resolve the conflict and submit\
		    again."
	}

    } else {
	# No conflict.  Try to commit the new revision to CVS

	set msg "Revision through web from $::post::name <$::post::email>"
	if {[info exists ::post::log] && [string length $::post::log]} {
	    append msg "\n" [string trim $::post::log]
	}

	if {[catch {cvs commit -m $msg $file} msg]} {

	    # A failed 'cvs commit' after a successful 'cvs update' probably
	    # means another 'cvs commit'  occurred (from somewhere other than
	    # the web interface) since our 'cvs update'.  Try again.
	    set postReleaseScript {
		attemptCommit h
	    }

	} else {
	    # Successful commit.
	    # Give it a second to push through, then redirect to the HTML
	    # rendering of the new revision.
	    set postReleaseScript {
	        after 2100
		puts "Location: $BASEURL$details(TIP).html"
		puts [cookieHeader tipwebEMAIL $::post::email]
		puts [cookieHeader tipwebNAME  $::post::name]
		puts ""
	    }
	}
    }

    releaseLock $h(TIP)
    eval $postReleaseScript
}

proc isWikispam {headerArray paragraphs {whyVar why}} {
    upvar 1 $headerArray h $whyVar why
    global DOCDIR

    # Spammers are lazy, real contributors are (usually) not.

    if {[llength [split $::post::name]] < 2} {
	set why "short real name"
	return 1
    }

    # Count the number of http urls in the original and the new
    # version. Note that these searches are *very* simple-minded, but
    # that should be enough.

    set old [getTIPFileContents [file join $DOCDIR $h(TIP).tip]]
    set oldCount 0
    set idx 0
    while {[set idx [string first http: $old $idx]] >= 0} {
	incr oldCount
	incr idx
    }

    set new [join $paragraphs]
    set newCount 0
    set idx 0
    while {[set idx [string first http: $new $idx]] >= 0} {
	incr newCount
	incr idx
    }

    # It's spam if more than two things that look vaguely like http
    # URIs are added in a single update
    if {$newCount > $oldCount + 2} {
	set why "too many added URLs"
	return 1
    }
    return 0
}

Added epstopdf.tcl.
































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
# Procedure to convert Encapsulated Postscript into PDF by passing
# through ghostscript with the right arguments and with the bounding
# box fixed(!)  Based very strongly on the EPSTOPDF script distributed
# with teTeX-1.0 though with some changes (most notably support for
# controlling the level of PDF generated, and redesigned for more
# efficient use as part of a larger work.)

# This version by Donal K. Fellows, University of Manchester

# Original by Sebastian Rahtz et al.

namespace eval epstopdf {
    proc correctBbox {llx lly urx ury} {
	variable corrected 1
	set width [expr {$urx-$llx}]
	set height [expr {$ury-$lly}]
	format "%%BoundingBox: 0 0 %d %d\n<< /PageSize \[%s %s\] >>\
		setpagedevice gsave %s %s translate" \
		$width $height $width $height [expr {-$llx}] [expr {-$lly}]
    }
    proc processHeader {bbstring} {
	variable in
	variable out
	variable isfile

	set spc "\[ \t\]"
	set elm {([-0-9e.]+)}
	set bboxRE  "^%%${bbstring}:$spc*$elm$spc+$elm$spc+$elm$spc+$elm"
	set atendRE "^%%${bbstring}:$spc*\\(atend\\)"
	while {[gets $in line] >= 0} {
	    ### end of header
	    if {
		![string match %* $line] ||
		[string match %%EndComments* $line]
	    } then {
		puts $out $line
		break
	    }

	    ### BoundingBox with values
	    if {[regexp $bboxRE $line -> llx lly urx ury]} {
		puts $out [correctBbox $llx $lly $urx $ury]
		break
	    }

	    ### BoundingBox with (atend)
	    # Can only be processed if seek/tell work (i.e. is ordinary file)
	    if {[regexp $atendRE $line] && $isfile} {
		set pos [tell $in]
		# looking for %%BoundingBox
		while {[gets $in line] >= 0} {
		    # skip over included documents
		    if {[string match %%BeginDocument* $line]} {
			while {[gets $in line] >= 0} {
			    if {[string match %%EndDocument* $line]} {break}
			}
		    }
		    if {[regexp $bboxRE $line -> llx lly urx ury]} {
			puts $out [correctBbox $llx $lly $urx $ury]
			break
		    }
		}

		# go back
		seek $in $pos
		break
	    }

	    # print header line
	    puts $out $line
	}
    }

    variable options
    array set options {
	UseFlateCompression true
	CompatibilityLevel  1.2
    }
    if {![info exist ::GS]} {
	set ::GS gs
    }

    namespace export epstopdf
    proc epstopdf {infile {outfile ""} {bbstring "BoundingBox"}} {
	variable options
	variable in
	variable out
	variable corrected 0
	variable isfile
	global GS

	if {![string length $outfile]} {
	    if {[string compare [file extension $infile] .eps]} {
		return -code error "cannot guess output filename"
	    }
	    set outfile [file rootname $infile].pdf
	}

	set cmd [list $GS -q -sDEVICE=pdfwrite -sOutputFile=$outfile]
	foreach key [array names options] {
	    lappend cmd -d$key=$options($key)
	}
	lappend cmd - -c quit

	set isfile [file isfile $infile]
	set in [open $infile r]
	fconfigure $in -translation binary
	set out [open |$cmd w]
	fconfigure $out -translation binary

	gets $in line
	# Trim leading junk which some EPS generators insist on adding
	set line [string range $line [string first %! $line] end]
	puts $out $line

	if {[string match %* $line]} {
	    processHeader $bbstring
	}
	fcopy $in $out
	close $in
	if {$corrected} {
	    puts $out grestore
	} else {
	    puts stderr "warning: $bbstring not found in $infile"
	}
	close $out
    }
}

Added history.tcl.
































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
source $SRCDIR/cvs.tcl

proc history::logentries {file} {
    set entries {}
    set gotfirst 0
    set pattern1 ----------------------------
    set pattern0 =============================================================================
    foreach line [split [string trim [cvs log -N $file]] "\n"] {
	if {[string match $pattern0 $line]} {
	    lappend entries $accum
	    break
	}
	if {[string match $pattern1 $line]} {
	    if {$gotfirst} {
		lappend entries $accum
	    } else {
		set gotfirst 1
	    }
	    set accum {}
	    continue
	}
	lappend accum $line
    }
    set revisions {}
    array set info {}
    foreach entry $entries {
	regexp {revision (.*)} [lindex $entry 0] -> revision
	lappend revisions $revision
	foreach kv [split [lindex $entry 1] ";"] {
	    set kv [string trim $kv]
	    if {![string length $kv]} {continue}
	    regexp {([^:]+): +(.*)} $kv -> key value
	    set info($revision,$key) $value
	}
	# Trim off unwanted lines
	set log [lrange $entry 2 end]
	while {[string match {branches: *;} [lindex $log 0]]} {
	    set log [lrange $log 1 end]
	}
	set info($revision,logmsg) [join $log "\n"]
    }
    return [list $revisions [array get info]]
}

proc history::difflines {file r1 r2} {
    set lines {}
    set inheader 1
    set seppat @@*@@
    catch {cvs diff -u -b -r$r1 -r$r2 $file} msg
    foreach line [split [string trim $msg] \n] {
	if {[string match $seppat $line]} {
	    if {!$inheader} {
		lappend lines sep
	    } else {
		set inheader 0
	    }
	} elseif {!$inheader} {
	    regexp {(.)(.*)} $line -> type content
	    while {[regexp -indices "\t" $content tabpos]} {
		set tabpos [lindex $tabpos 0]
		set pre [string range $content 0 [expr {$tabpos-1}]]
		set post [string range $content [expr {$tabpos+1}] end]
		### [string repeat] is not available in 8.0
		append pre " "
		while {[string length $pre]%8} {append pre " "}
		set content $pre$post
	    }
	    switch -- $type {
		-   {lappend lines [list del $content]}
		+   {lappend lines [list add $content]}
		" " {lappend lines [list ctx $content]}
	    }
	}
    }
    return $lines
}

proc history::quoteEnt {string} {
    regsub -all &  $string {\&amp;}  string
    regsub -all \" $string {\&quot;} string
    regsub -all <  $string {\&lt;}   string
    regsub -all >  $string {\&gt;}   string
    return $string
}
proc history::quoteEmail1 {string} {
    global EmailRE
    regsub -all $EmailRE $string "<\x80\\1\x81>" string
    return $string
}
proc history::quoteEmail2 {string tip} {
    while {[regexp -indices "\x80\[^\x80\x81\]+\x81" $string locn]} {
	foreach {first last} $locn {}
	set mail [string range $string [expr {$first+1}] [expr {$last-1}]]
	foreach {user sys} [split $mail @] {break}
	regsub -all {\.} $user " <span class=\"midmail\">dot</span> " user
	regsub -all {\.} $sys " <span class=\"midmail\">dot</span> " sys
	set newstring [string range $string 0 [expr {$first-1}]]
	append newstring "$user <span class=\"midmail\">at</span> $sys"
	set string $newstring[string range $string [expr {$last+1}] end]
    }
    return $string
}

proc history::fmtlogentries {tipid} {
    set loginfo [logentries $tipid.tip]
    array set info [lindex $loginfo 1]

    variable infobg
    variable logbg

    append puts "<table><tr><th width=\"1\">Version</th><th\
	    width=\"1\">Author</th><th width=\"1\">Date</th><th\
	    width=\"1\">Quick Comparison</th></tr>\n"
    set vs [lsort -dictionary [lindex $loginfo 0]]
    foreach v $vs {
	# hardcoded value!
	if {![string compare $info($v,author) "tclhttpd"]} {
	    set info($v,author) "<i>WebEdit</i>"
	}
	append puts "<tr><td bgcolor=\"$infobg\">$v</td><td\
		bgcolor=\"$infobg\">$info($v,author)</td><td\
		bgcolor=\"$infobg\">$info($v,date)</td>\n"
	append puts "<td bgcolor=\"$infobg\"><a href=\"view/$tipid?ver=$v\"\
		onmouseover=\"window.status='View this version';return\
		true\"><b>View this version</b></a></td>\n"
	append puts "</tr>\n"
	append puts "<tr><td colspan=\"4\"><table border width=\"100%\"\
		bgcolor=\"$logbg\"><tr><td><b>Log Message</b><pre>\n"
	set loglines [quoteEmail1 $info($v,logmsg)]
	set loglines [join [split [quoteEnt $loglines] "\n"] "\n  "]
	set loglines [quoteEmail2 $loglines $tipid]
	append puts "  $loglines</pre></td></tr></table></td></tr>\n"
    }
    append puts "<tr><td colspan=\"4\" align=\"center\"><form method=\"get\"\
	    action=\"compare/$tipid\">\n"
    append puts "<select name=\"cmpa\"><option\
	    selected>[lindex $vs 0]</option>"
    foreach v [lrange $vs 1 end] {
	append puts "<option>$v</option>"
    }
    append puts "\n</select><input type=\"submit\" value=\"compared\
	    with\"><select name=\"cmpb\">\n"
    foreach v [lrange $vs 0 [expr {[llength $vs]-2}]] {
	append puts "<option>$v</option>"
    }
    append puts "<option selected>[lindex $vs end]</option></select>\n"
    append puts "</form></td></tr>"
    append puts "</table>"
}

proc history::fmtdifflines {tipid r1 r2} {
    variable addbg
    variable delbg

    set old {}
    set lineinfo [difflines $tipid.tip $r1 $r2]
    set maxl 0

    if {![llength $lineinfo]} {
	return "<p>No differences or at least one version non-existent.</p>"
    }

    foreach line $lineinfo {
	set len [string length [lindex $line 1]]
	if {$len>$maxl} {set maxl $len}
    }
    append puts "<pre>\n"
    foreach line $lineinfo {
	set c [quoteEnt [format %-*s $maxl [lindex $line 1]]]
	append puts $old
	set old {}
	switch [lindex $line 0] {
	    sep {append puts "<hr width=\"75%\" align=\"left\" noshade>"}
	    ctx {append puts "$c\n"}
	    add {
		append puts "<span style=\"background-color: $addbg\">$c\n"
		set old "</span>"
	    }
	    del {
		append puts "<span style=\"background-color: $delbg\">$c\n"
		set old "</span>"
	    }
	    default {append puts ==$line==\n}
	}
    }
    append puts "</pre>"
}

proc history::fmtrevision {tipid revision} {
    set document [cvs update -pr $revision $tipid.tip 2>/dev/null]
    formatTIPDocument $document html $revision
}

Added imwidth.tcl.












































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
namespace eval ::imwidth {
    namespace export getImageWidth

    variable imageWidthCache
    array set imageWidthCache {}
    proc getImageWidth {imagefile} {
	variable imageWidthCache
	if {![info exist imageWidthCache($imagefile)]} {
	    set imageWidthCache($imagefile) 0
	    if {[catch {
		set imageWidthCache($imagefile) [getImageWidthCore $imagefile]
	    } msg]} {
		puts "DEBUG: imwidth $imagefile -> $msg"
		puts ErrorCode=$::errorCode
		puts ErrorInfo=$::errorInfo
	    }
	}
	return $imageWidthCache($imagefile)
    }
    proc getImageWidthCore {imagefile} {
	global contenttypes
	set ext [file extension $imagefile]
	if {![string compare $contenttypes($ext) application/postscript]} {
	    return [epswidth $imagefile]
	}
	if {![regexp {image/([-a-z]+)} $contenttypes($ext) -> type]} {
	    return 0
	}
	switch $type {
	    gif {
		return [gifsize $imagefile]
	    }
	    jpeg {
		return [get_jpg_width $imagefile]
	    }
	    png {
		return [pngsize $imagefile]
	    }
	    x-portable-pixmap {
		return [PPMwidth $imagefile]
	    }
	}
	return 0
    }

    proc PPMwidth {filename} {
	set f [open $imagefile r]
	gets $f;# Read magic number
	while {[gets $f s]+1&&[string length $s]&&[string match #* $s]} {}
	close $f
	scan $s %d width
	return $width
    }

    # From the Wiki!
    proc gifsize {name} {
	set f [open $name r]
	fconfigure $f -translation binary
	# read GIF signature -- check that this is
	# either GIF87a or GIF89a
	set sig [read $f 6]
	switch $sig {
	    "GIF87a" -
	    "GIF89a" {
		# do nothing
	    }
	    default {
		error "$f is not a GIF file"
	    }
	}

	# Read "logical screen size", this is USUALLY the image size
	# too.  Interpreting the rest of the GIF specification is left
	# as an exercise
	binary scan [read $f 2] s wid

	return $wid
    }

    # From the Wiki!
    proc get_jpg_width {filename} {
	# open the file
	set img [open $filename r+]
	# set to binary mode - VERY important
	fconfigure $img -translation binary

	# read in first two bytes
	binary scan [read $img 2] "H4" byte1
	# check to see if this is a JPEG, all JPEGs start with "ffd8", make
	# that SHOULD start with
	if {$byte1!="ffd8"} {
	    close $img
	    error "$filename is not a valid JPEG file!"
	}

	# cool, it's a JPG so let's loop through the whole file until we
	# find the next marker.
	while { ![eof $img]} {
	    while {$byte1!="ff"} {
		binary scan [read $img 1] "H2" byte1
	    }

	    # we found the next marker, now read in the marker type byte,
	    # throw out any extra "ff"'s
	    while {$byte1=="ff"} {
		binary scan [read $img 1] "H2" byte1
	    }

	    # if this the the "SOF" marker then get the data
	    if { ($byte1>="c0") && ($byte1<="c3") } {
		# it is the right frame. read in a chunk of data
		# containing the dimensions.
		binary scan [read $img 7] "x3SS" height width
		# return the dimensions in a list
		close $img
		return $width
	    } else {
		# this is not the the "SOF" marker, read in the offset of the
		# next marker
		binary scan [read $img 2] "S" offset
		# the offset includes its own two bytes so we need to subtract
		# them
		set offset [expr $offset -2]
		# move ahead to the next marker
		seek $img $offset current
	    }

	}
	# we didn't find an "SOF" marker...
	close $img
	return 0
    }

    # From the Wiki!
    proc pngsize {filename} {
	if {[file size $filename] < 33} {
	    error "File $filename not large enough to contain PNG header"
	}
	set f [open $filename r]
	fconfigure $f -translation binary

	# Read PNG file signature
	binary scan [read $f 8] H* sig
	if {[string compare $sig 89504e470d0a1a0a]} {
	    close $f
	    error "$filename is not a PNG file"
	}

	# Read IHDR chunk signature - the length (0x0000000d) never
	# changes, and the 49484452 should also always be there as it
	# is the string "IHDR"!
	binary scan [read $f 8] H* sig
	if {[string compare $sig 0000000d49484452]} {
	    close $f
	    error "$filename is missing a leading IHDR chunk"
	}

	# Read off the size of the image
	binary scan [read $f 8] II width height
	# Ignore the rest of the data, including the chunk CRC, since I have
	# no convenient algorithm to verify it!

	#binary scan [read $f 5] ccccc depth type compression filter interlace
	#binary scan [read $f 4] I chunkCRC

	close $f
	return $width
    }

    proc epswidth {filename} {
	set f [open $filename r]
	gets $f line
	if {![string match %!PS-Adobe* $line]} {close $f; return 0}
	if {![regexp EPSF $line]} {close $f; return 0}
	set quad {0 0 -1 -1}
	set land 0
	while {[string match %* $line]} {
	    gets $f line
	    switch -glob -- $line {
		"%%BoundingBox: *" {
		    set quad [string range $line 15 end]
		}
		"%%Orientation: Landscape" {
		    set land 1
		}
		"%%EndComments" - "%%BeginSetup" {
		    break
		}
	    } 
	}
	close $f
	if {$land} {
	    return [expr {[lindex $quad 3]-[lindex $quad 1]+1}]
	} else {
	    return [expr {[lindex $quad 2]-[lindex $quad 0]+1}]
	}
    }
}

Added mail.tcl.
































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
#source $SRCDIR/post.tcl
namespace eval ::mail {
    namespace export mailform mailformaccept mailsend

    proc row {c1 c2 args} {
	if {[string length $c1]} {
	    puts -nonewline "<tr><th align=\"left\">$c1</th><td\
		    valign=\"top\">"
	} else {
	    puts -nonewline "<tr><td></td><td valign=\"top\">"
	}
	puts [eval [list format "$c2</td></tr>"] $args]
    }
    proc row_a {c1 c2 args} {
	if {[string length $c1]} {
	    puts -nonewline "<tr><th align=\"left\"\
		    valign=\"top\">$c1</th><td valign=\"top\">"
	} else {
	    puts -nonewline "<tr><td></td><td valign=\"top\">"
	}
	puts [eval [list format "$c2</td></tr>"] $args]
    }

    proc dotify {str} {
	regsub -all {\.} $str " <span class=\"midmail\">dot</span> " str
	return $str
    }

    proc mailform {name user sys tipnum} {
	global BASEURL CSSURL ICONURL DOCTYPE DOCDIR TCLCOREMAIL SENDMAILURL
	if {![string length $name]} {
	    set syntheticName 1
	    set hname "${user}_at_${sys}"
	    set name [dotify "$user <span class=\"midmail\">at</span> $sys"]
	} else {
	    set hname $name
	}
	puts "Content-Type: text/html; charset=iso-8859-1"
	puts ""
	puts $DOCTYPE
	puts "<html><head><title>Compose Mail to $hname About\
		TIP#$tipnum</title>"
	puts "<meta http-equiv=\"Content-Type\"\
		content=\"text/html; charset=iso-8859-1\">"
	puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
	puts "<base href=\"$BASEURL\" target=\"body\">"
	puts "<link rel=\"stylesheet\" type=\"text/css\" \
		title=\"My standard style\" href=\"$CSSURL\">"
	puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
	puts "</head><body bgcolor=\"#d9d9d9\">"
	puts "<h1>Composing Email Message to $name About TIP#$tipnum</h1><hr>"
	puts "<form method=\"POST\" action=\"$SENDMAILURL\"><table>"
	set hide [list user $user sys $sys tipnum $tipnum]
	if {![info exist syntheticName]} {
	    lappend hide name $name
	}
	row From: "<input type=\"text\" name=\"from\">"
	row "" "<p align=\"justify\">Please note that you will be Cc'ed with\
		whatever message you create here, so you can retain a record\
		of your messages if you wish.</p>"
	row To: "%s &lt;%s <span class=\"midmail\">at</span> %s&gt;" \
		$name [dotify $user] [dotify $sys]
	foreach {tc_user tc_sys} [split $TCLCOREMAIL @] {break}
	if {
	    [string compare $user $tc_user] ||
	    [string compare $sys $tc_sys]
	} then {
	    row "" "<input type=\"checkbox\" name=\"cccore\"\
		    value=\"cccore\"> Send <b>Cc:</b> to %s <span\
		    class=\"midmail\">at</span> %s" \
		    [dotify $tc_user] [dotify $tc_sys]
	}
	if {[regexp {^[0-9]+$} $tipnum]} {
	    array set tipd [getTIPDetails [file join $DOCDIR $tipnum.tip]]
	    row Subject: "Re: TIP#%d: %s" $tipnum $tipd(Title)
	    lappend hide subject "Re: TIP#${tipnum}: $tipd(Title)"
	} else {
	    row Subject: "<input type=\"text\" name=\"subject\">"
	}
	row_a Body: "<textarea name=\"body\" rows=\"12\" cols=\"72\"\
		wrap=\"physical\"></textarea>"
	puts "<tr><td colspan=\"2\"><input type=\"submit\"\
		value=\"Send Email\"> &nbsp; <input type=\"reset\"\
		></td></tr></table>"
	if {[info exist ::env(HTTP_REFERER)]} {
	    lappend hide ref $::env(HTTP_REFERER)
	} else {
	    lappend hide ref $BASEURL/$tipnum
	}
	foreach {key val} $hide {
	    regsub -all & $val {\&amp;} val
	    regsub -all < $val {\&lt;} val
	    regsub -all > $val {\&gt;} val
	    regsub -all \" $val {\&quot;} val
	    puts "<input type=\"hidden\" name=\"$key\" value=\"$val\">"
	}
	puts -nonewline "</form>"
	basicHTMLfooter
	exit
    }

    proc mailformaccept {} {
	variable ::post::name	 ;#"NO NAME"
	variable ::post::user	 ;#no.name
	variable ::post::sys	 ;#all
	variable ::post::tipnum  ;#-1
	variable ::post::from	 ;#[email protected]
	variable ::post::subject ;#TEST
	variable ::post::body	 ;#"TESTING...\r\n1, 2, 3, 4, 5\r\n"
	variable ::post::ref     ;#$::BASEURL
	variable ::post::cccore  ;#{}

	if {![regexp {^[^,][email protected][^,]+\.[^,]+$} $from]} {
	    generr "Bad From Email Address" \
		    "this system will not send mail purporting to come\
		    from $from"
	}
	if {[regexp {[^a-zA-Z0-9_.]} $user]||[regexp {[^a-zA-Z0-9_.]} $sys]} {
	    generr "Bad To Email Address" \
		    "this system will not send mail to [dotify $user] <span\
		    class=\"midmail\">at</span> [dotify $sys]"
	}

	#::post::getVars
	set cccore [expr {[info exist cccore] && [string length $cccore]}]
	if {![info exist name]} {
	    set name {}
	}
	# Apply the CRLF->LF translation ourselves
	regsub -all "\r\n" $body "\n" body
	processmail $name $user $sys $tipnum $from $subject $body $ref $cccore
    }

    proc addmailhdr {var key val} {
	# Effectively a sanitised append
	upvar 1 $var v
	regsub -all "\[\r\n\t \]+" $val " " val
	append v "${key}: $val\n"
    }
    proc processmail {name user sys tipnum from subject body ref cccore} {
	global env TCLCOREMAIL

	set hdr ""
	addmailhdr hdr From $from
	addmailhdr hdr Cc $from
	addmailhdr hdr To "$name <[email protected]$sys>"
	addmailhdr hdr Subject $subject
	if {$cccore} {
	    addmailhdr hdr Cc $TCLCOREMAIL
	}
	addmailhdr hdr Errors-To [email protected]
	addmailhdr hdr X-Tip-Number $tipnum
	addmailhdr hdr MIME-Version 1.0
	addmailhdr hdr Content-Type {text/plain; charset=iso-8859-1}
	addmailhdr hdr Content-Transfer-Encoding 8bit
	addmailhdr hdr Date [clock format [clock seconds] -gmt 1 -format \
		"%a, %d %b %Y %H:%M:%S +0000\n"]
	addmailhdr hdr X-Note "Message generated through web interface"
	catch {addmailhdr hdr X-Submitting-Ip $env(REMOTE_ADDR)}
	catch {addmailhdr hdr X-Submitting-User-Agent $env(HTTP_USER_AGENT)}

	mailsend $hdr\n[string trim $body \n]\n

	# Redirect back to where we originally came from
	puts "Location: $ref\n"
    }

    proc mailsend {message {redir 0}} {
	global SENDMAIL
	if {$redir} {
	    exec $SENDMAIL -oi -t <<$message >@stdout 2>@stderr
	} else {
	    exec $SENDMAIL -oi -t <<$message
	}
    }
}

Added mailnote.tcl.




























































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
#! /bin/sh
# \
exec tclsh "$0" ${1+"[email protected]"}

### READ STANDARD CONFIG ###
set SRCDIR [file join [pwd] [file dir $argv0]]
source $SRCDIR/config.tcl

### NEW GLOBALS WITH POSSIBLE VALUES ###

# NOTIFYDB  = [file join [file dir $LOGFILE] notify.db]
# ID        = /usr/bin/id
# MAILX     = /usr/bin/mailx
# WEBEDITID = tclhttpd
# NOTIFYURL = ${BASEURL}notify.html

### HELPER PROCEDURES ###
proc readNotifyDB {} {
    # NB This procedure needs some kind of locking protocol...

    global NOTIFYDB
    set fid [open $NOTIFYDB r]
    set lines [read $fid]
    close $fid
    return $lines
}
proc readLogMessage {} {
    set lines {}
    set readlog 0
    while {[gets stdin line]} {
	if {$readlog} {
	    lappend lines $line
	} else {
	    set readlog [string match "Log Message:" $line]
	}
    }
    return [join $lines "\n"]
}
proc getUserID {} {
    global ID
    if {[regexp {uid=[0-9]+\([a-zA-Z0-9_]+\)} [exec $ID] -> id]} {
	return $id
    } else {
	return "unknown user"
    }
}
proc mail {address subject args} {
    global MAILX
    set body [join $args "\n\n"]
    exec $MAILX -s $subject $address << "$body\n"
}

### IMPLEMENTATION ###

# Read this first; probably ought to add some kind of locking mechanism.
set notifylines [readNotifyDB]

set logmsg [readLogMessage]

set id [getUserID]
if {![string compare $id $WEBEDITID]} {
    set mod "Modified over the web (see log message)"
} else {
    set mod "Modified by: $id"
}

# changed($file) exists if $file was changed
array set changed {}
foreach file $argv {
    set changed($file) $file
}

foreach line [split $notifylines "\n"] {
    if {[regexp "^(\[0-9\]+)\[ \t\]+(.*@.*)" $line -> tip mail]} {
	catch {
	    # if $email didn't want to be notified about any of the
	    # files mentioned in this log notification, then the
	    # reading of changed($tip.tip) will fail
	    mail $mail "\[TIP Archive] $changed($tip.tip) modified" \
		    "TIP #$tip has been modified, and you might wish to\
		    check it out.\n   $BASEURL$tip.html" "To remove your\
		    email address from the notification list for this\
		    TIP,\nvisit the page, confirm your email address and\
		    select 'Remove':\n   $NOTIFYURL?tip=$tip,email=$mail" \
		    "Log message associated with the update is as\
		    follows:\n$logmsg"
	}
    } elseif {[regexp {^\*(.*@.*)} $line -> mail]} {
	mail $mail "\[TIP Archive] update done" "Files modified: $argv\n$mod"\
		"Log message:\n$logmsg"
    }
}

exit

Added makeconfig.tcl.








































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
#! /bin/sh
# Re-execute using wish \
exec wish "$0" $*


### ATTEMPT TO LOAD PREVIOUSLY-CREATED VERSION AND SET UP SRCDIR VAR ###
set SRCDIR [file join [pwd] [file dir $argv0]]
regsub -all {/\./} $SRCDIR / SRCDIR
regsub -all {/\.$} $SRCDIR {} SRCDIR

namespace eval configure {
    variable conffile [file join $::SRCDIR config.tcl]
    variable deffile  [file join $::SRCDIR conf_def.tcl]
    variable showall \
	    [expr {[string compare [lindex $::argv 0] "-expert"] == 0}]

    variable variables      {}
    variable optional       {}
    variable pages          {}
    variable header         {}
    variable introMessage   {}
    variable postUserScript {}
}

puts "Loading old configuration: $::configure::conffile"
catch {source $::configure::conffile}

puts "Loading setup: $::configure::deffile"
source $::configure::deffile

namespace eval configure {
    namespace export runGUI writeConfig

    variable name
    set name() $introMessage
    variable kinds
    set kinds() message

    ### HELPER PROCEDURES ###
    proc selectColour {var} {
	variable name
	upvar #0 $var colourVar
	set col [tk_chooseColor -parent .t -initialcolor $colourVar \
		-title $name($var)]
	if {[string length $col]} {
	    set colourVar $col
	}
    }
    proc selectFile {var} {
	variable name
	upvar #0 $var fileVar
	set file [tk_getOpenFile -parent .t -initialdir [file dir $fileVar] \
		-title $name($var)]
	if {[string length $file]} {
	    set fileVar $file
	}
    }
    proc selectDir {var} {
	variable name
	upvar #0 $var dirVar
	set dir [tk_chooseDirectory -parent .t -initialdir $dirVar \
		-title $name($var) -mustexist 1]
	if {[string length $dir]} {
	    set dirVar $dir
	}
    }

    ### BALLOON HELP ###
    proc balloonIn {w msg} {
	if {![winfo exist .balloon]} {
	    toplevel .balloon
	    wm overrideredirect .balloon 1
	    label .balloon.l -foreground blue -background yellow \
		    -highlightthick 0 -relief solid -borderwidth 1 \
		    -font {Helvetica -10} -textvariable ::configure::balloon
	    pack .balloon.l
	}
	variable balloon $msg
	set x [expr {[winfo rootx $w]+10}]
	set y [expr {[winfo rooty $w]+[winfo height $w]+5}]
	set g [format +%d+%d $x $y]
	wm geometry .balloon $g
	wm deiconify .balloon
	wm geometry .balloon $g
	raise .balloon
	after idle "[list wm geometry .balloon $g]; raise .balloon"
    }
    proc balloonOut {} {
	if {[winfo exist .balloon]} {
	    wm withdraw .balloon
	}
    }
    proc bindBalloon {msg r args} {
	foreach w $args {
	    bind $w <Enter> [namespace code [list balloonIn $r $msg]]
	    bind $w <Leave> [namespace code balloonOut]
	}
    }

    ### HANDLE THE GUI FOR A SINGLE EDITING PAGE ###
    proc displayPage {pagedesc first last} {
	variable forwardback
	variable kinds
	variable name
	variable showall

	toplevel .t
	wm title .t [lindex $pagedesc 0]
	wm geometry .t +80+80
	set i 0
	set serif {Times 14}
	set sans  {Helvetica 14}
	set ss    {Helvetica 10 bold}
	set mono  {Courier 10}
	set bold  {Helvetica 18 bold}
	set focusmagic {}

	set havedirb [llength [info command tk_chooseDirectory]]
	set havespin [llength [info command spinbox]]

	foreach var [lrange $pagedesc 1 end] {
	    set kind $kinds($var)
	    switch $kind {
		message {#ignore}
		dir {
		    if {$havedirb} {
			set msg "Please choose a directory (you can use the\
				button at the right to summon a directory\
				browser.)"
		    } else {
			set msg "Please choose a directory."
			set kind string
		    }
		}
		file {
		    set msg "Please choose a file (you can use the\
			    button at the right to summon a file browser.)"
		}
		color - colour {
		    set msg "Please choose a $kind (you can use the button\
			    at the right to summon a $kind browser.)"
		}
		string {
		    set msg "Input a string value here."
		}
		number {
		    set msg "Input a numeric value here."
		    if {!$havespin} {set kind string}
		}
		boolean {
		    set msg "Click here to toggle this feature on or off."
		}
	    }
	    if {$showall && [string length $var]} {
		set msg "Variable: $var"
	    }
	    switch $kind {
		message {
		    pack [message .t.m$i -text $name($var) -font $serif \
			    -anchor w] -fill x -expand 1
		    bind .t <Configure> [list .t.m$i configure -width %w]
		}
		dir {
		    lappend focusmagic .t.f$i.e
		    label .t.l$i -text $name($var) -anchor w -font $serif
		    pack .t.l$i [frame .t.f$i] -fill x -expand 1
		    entry .t.f$i.e -textvariable $var -bg white -font $mono
		    button .t.f$i.b -text "Browse" -font $ss -takefocus 0 \
			    -command [list selectDir $var] -padx 2 -pady 0
		    pack .t.f$i.e .t.f$i.b -fill both -side left
		    pack configure .t.f$i.e -expand 1
		    bindBalloon $msg .t.f$i .t.l$i .t.f$i.e .t.f$i.b
		}
		file {
		    lappend focusmagic .t.f$i.e
		    label .t.l$i -text $name($var) -anchor w -font $serif
		    pack .t.l$i [frame .t.f$i] -fill x -expand 1
		    entry .t.f$i.e -textvariable $var -bg white -font $mono
		    button .t.f$i.b -text "Browse" -font $ss -takefocus 0 \
			    -command [list selectFile $var] -padx 2 -pady 0
		    pack .t.f$i.e .t.f$i.b -fill both -side left
		    pack configure .t.f$i.e -expand 1
		    bindBalloon $msg .t.f$i .t.l$i .t.f$i.e .t.f$i.b
		}
		color - colour {
		    lappend focusmagic .t.f$i.e
		    label .t.l$i -text $name($var) -anchor w -font $serif
		    pack .t.l$i [frame .t.f$i] -fill x -expand 1
		    entry .t.f$i.e -textvariable $var -bg white -font $mono
		    button .t.f$i.b -text "Browse" -font $ss -takefocus 0 \
			    -command [list selectColour $var] -padx 2 -pady 0
		    pack .t.f$i.e .t.f$i.b -fill both -side left
		    pack configure .t.f$i.e -expand 1
		    bindBalloon $msg .t.f$i .t.l$i .t.f$i.e .t.f$i.b
		}
		string {
		    lappend focusmagic .t.e$i
		    label .t.l$i -text $name($var) -anchor w -font $serif
		    entry .t.e$i -textvariable $var -bg white -font $mono
		    pack .t.l$i .t.e$i -fill x -expand 1
		    bindBalloon $msg .t.e$i .t.l$i .t.e$i
		}
		number {
		    lappend focusmagic .t.e$i
		    label .t.l$i -text $name($var) -anchor w -font $serif
		    spinbox .t.e$i -textvariable $var -bg white -font $mono
		    pack .t.l$i .t.e$i -fill x -expand 1
		    bind .t.e$i <Up>   [list incr $var]
		    bind .t.e$i <Down> [list incr $var -1]
		    bindBalloon $msg .t.e$i .t.l$i .t.e$i
		}
		boolean {
		    lappend focusmagic .t.b$i
		    pack [checkbutton .t.b$i -text $name($var) -anchor w \
			    -font $sans -variable $var] -fill x -expand 1
		    bindBalloon $msg .t.b$i .t.b$i
		}
	    }
	    incr i
	}
	pack [frame .t.bottom] -expand 1 -fill both
	button .t.bottom.left -text "<< Back" -font $bold -default normal \
		-command {set ::configure::forwardback -1}
	if {$first} {
	    .t.bottom.left configure -state disabled -font $bold
	    bind .t <Escape> {set ::configure::forwardback 0}
	} else {
	    bind .t <Escape> {set ::configure::forwardback -1}
	}
	button .t.bottom.middle -text "Cancel" -font $bold -default normal \
		-command {set ::configure::forwardback 0}
	button .t.bottom.right -text "Next >>" -font $bold -default active \
		-command {set ::configure::forwardback 1}
	if {$last} {
	    .t.bottom.right configure -text "Write Config"
	}
	pack .t.bottom.left .t.bottom.middle .t.bottom.right \
		-expand 1 -fill both -side left
	bind .t.bottom <Destroy> {set ::configure::forwardback 0}
	bind .t <Return> {set ::configure::forwardback 1}
	if {[string length $focusmagic]} {
	    focus [lindex $focusmagic 0]
	} else {
	    focus .t.bottom.right
	}
	vwait ::configure::forwardback
	if {[winfo exist .t.bottom]} {
	    bind .t.bottom <Destroy> {}
	    destroy .t
	}
	return $forwardback
    }

    ### RUN THE CONFIGURATION GUI ###
    proc runGUI {} {
	variable showall
	variable kinds
	variable variables
	variable optional
	variable pages
	variable name

	set pageidx 0
	set step 1
	array set defs {}
	while {$step && $pageidx>=0} {
	    foreach {var kind val doc} $variables {
		set name($var) $doc
		set dynamic [regexp {[\[$]} $val]
		if {$dynamic || ![info exist ::$var]} {
		    if {$dynamic} {
			set defs($var) $val
		    }
		    set ::$var [uplevel #0 [list subst $val]]
		}
		set kinds($var) $kind
	    }

	    while {$pageidx < [llength $pages]} {
		set page [lindex $pages $pageidx]
		foreach var [lrange $page 1 end] {
		    if {[string length $var] && [info exist defs($var)]} {
			set ::$var [uplevel #0 [list subst $defs($var)]]
			#puts "$var = [set ::$var]"
		    }
		}
		if {$showall || [lsearch $optional [lindex $page 1]]<0} {
		    set step [displayPage $page [expr {$pageidx==0}] \
			    [expr {$pageidx==[llength $pages]-1}]]
		}
		if {!$step} {
		    return 0
		}
		incr pageidx $step
	    }
	    set done 1
	    foreach {var ? ? ?} $variables {
		if {![string length [set ::$var]]} {
		    tk_messageBox -type ok -icon error \
			    -title "Missing value" \
			    -message "You must supply a value for all fields"
		    set done 0
		    set pageidx 1
		    set step 1
		    break
		}
	    }
	    if {$done} {break}
	}

	return [expr {$step > 0}]
    }

    ### WRITE THE NEW VERSION OF THE CONFIGURATION FILE ###
    proc writeConfig {} {
	variable conffile
	variable variables
	variable header

	set fid [open $conffile w]
	foreach line [split $header "\n"] {
	    puts $fid [string trimleft $line]
	}
	foreach {var ? ? ?} $variables {
	    puts $fid [list set $var [set ::$var]]
	}
	close $fid
    }
}

### TOP LEVEL CODE ###
wm withdraw .
if {[configure::runGUI]} {
    eval $configure::postUserScript
    puts "Writing new configuration: $::configure::conffile"
    configure::writeConfig
} else {
    puts "Cancelled; $::configure::conffile unchanged"
}
exit

Added md5.tcl.






















































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
##################################################
#
# md5.tcl - MD5 in Tcl
# Author: Don Libes <[email protected]>, July 1999
# Version 1.2.0
#
# MD5  defined by RFC 1321, "The MD5 Message-Digest Algorithm"
# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication"
#
# Most of the comments below come right out of RFC 1321; That's why
# they have such peculiar numbers.  In addition, I have retained
# original syntax, bugs in documentation (yes, really), etc. from the
# RFC.  All remaining bugs are mine.
#
# HMAC implementation by D. J. Hagberg <[email protected]> and
# is based on C code in RFC 2104.
#
# For more info, see: http://expect.nist.gov/md5pure
#
# - Don
##################################################

### Code speedups by Donal Fellows <[email protected]> who may well
### have added some extra bugs of his own...  :^)

namespace eval md5pure {
    variable T {
	#PADDING

	0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee
	0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501
	0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be
	0x6b901122 0xfd987193 0xa679438e 0x49b40821

	0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa
	0xd62f105d 0x2441453  0xd8a1e681 0xe7d3fbc8
	0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed
	0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a

	0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c
	0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70
	0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05
	0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665

	0xf4292244 0x432aff97 0xab9423a7 0xfc93a039
	0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1
	0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1
	0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391
    }
}

# test md5pure
#
# This proc is not necessary during runtime and may be omitted if you
# are simply inserting this file into a production program.
#
proc md5pure::test {} {
    foreach {msg expected} {
	""
	  "d41d8cd98f00b204e9800998ecf8427e"
	"a"
	  "0cc175b9c0f1b6a831c399e269772661"
	"abc"
	  "900150983cd24fb0d6963f7d28e17f72"
	"message digest"
	  "f96b697d7cb7938d525a2f31aaf161d0"
	"abcdefghijklmnopqrstuvwxyz"
	  "c3fcd3d76192e4007dfb496cca67e13b"
	"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
	  "d174ab98d277d9f5a5611c2c9f419d9f"
	"12345678901234567890123456789012345678901234567890123456789012345678901234567890"
	  "57edf4a22be3c955ac49da2e2107b67a"
    } {
	puts "testing: md5 \"$msg\""
	binary scan [md5 $msg] H32 computed
	puts "expected: $expected"
	puts "computed: $computed"
	if {0 != [string compare $computed $expected]} {
	    puts "FAILED"
	} else {
	    puts "SUCCEEDED"
	}
    }
}

# time md5pure
#
# This proc is not necessary during runtime and may be omitted if you
# are simply inserting this file into a production program.
#
proc md5pure::time {} {
    foreach len {10 50 100 500 1000 5000 10000} {
	set time [::time {md5 [format %$len.0s ""]} 10]
	regexp "\[0-9]*" $time msec
	puts "input length $len: [expr {$msec/1000}] milliseconds per interation"
    }
}

proc md5pure::md5 {msg} {
    variable T

    #
    # 3.1 Step 1. Append Padding Bits
    #

    set msgLen [string length $msg]

    set padLen [expr {56 - $msgLen%64}]
    if {$msgLen % 64 > 56} {
	incr padLen 64
    }

    # pad even if no padding required
    if {$padLen == 0} {
	incr padLen 64
    }

    # append single 1b followed by 0b's
    append msg [binary format "a$padLen" \200]

    #
    # 3.2 Step 2. Append Length
    #

    # RFC doesn't say whether to use little- or big-endian
    # code demonstrates little-endian
    # This step limits our input to size 2^32b or 2^24B
    append msg [binary format "i1i1" [expr {8*$msgLen}] 0]
    
    #
    # 3.3 Step 3. Initialize MD Buffer
    #

    set A [expr 0x67452301]
    set B [expr 0xefcdab89]
    set C [expr 0x98badcfe]
    set D [expr 0x10325476]

    #
    # 3.4 Step 4. Process Message in 16-Word Blocks
    #

    # process each 16-word block
    # RFC doesn't say whether to use little- or big-endian
    # code says little-endian
    binary scan $msg i* blocks
    #set i 0
    #foreach b $blocks {
    #	 set M($i) $b
    #	 incr i
    #}

    set blockLen [llength $blocks]

    for {set i 0} {$i < $blockLen} {incr i 16} {
	# copy block i into X
	set X [lrange $blocks $i [expr {$i+15}]]
	#for {set j 0} {$j<16} {incr j} {
	#    set X($j) $M([expr $i*16+$j])
	#}

	# Save A as AA, B as BB, C as CC, and D as DD.
	set AA $A
	set BB $B
	set CC $C
	set DD $D

	# Round 1.
	# Let [abcd k s i] denote the operation
	#      a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s).
	# [ABCD  0  7  1]  [DABC  1 12  2]  [CDAB  2 17  3]  [BCDA  3 22  4]
	set A [expr {$B + [<<< [expr {$A + (($B&$C)|((~$B)&$D)) + [lindex $X 0]  + [lindex $T 1] }]  7]}]
	set D [expr {$A + [<<< [expr {$D + (($A&$B)|((~$A)&$C)) + [lindex $X 1]  + [lindex $T 2] }] 12]}]
	set C [expr {$D + [<<< [expr {$C + (($D&$A)|((~$D)&$B)) + [lindex $X 2]  + [lindex $T 3] }] 17]}]
	set B [expr {$C + [<<< [expr {$B + (($C&$D)|((~$C)&$A)) + [lindex $X 3]  + [lindex $T 4] }] 22]}]
	# [ABCD  4  7  5]  [DABC  5 12  6]  [CDAB  6 17  7]  [BCDA  7 22  8]
	set A [expr {$B + [<<< [expr {$A + (($B&$C)|((~$B)&$D)) + [lindex $X 4]  + [lindex $T 5] }]  7]}]
	set D [expr {$A + [<<< [expr {$D + (($A&$B)|((~$A)&$C)) + [lindex $X 5]  + [lindex $T 6] }] 12]}]
	set C [expr {$D + [<<< [expr {$C + (($D&$A)|((~$D)&$B)) + [lindex $X 6]  + [lindex $T 7] }] 17]}]
	set B [expr {$C + [<<< [expr {$B + (($C&$D)|((~$C)&$A)) + [lindex $X 7]  + [lindex $T 8] }] 22]}]
	# [ABCD  8  7  9]  [DABC  9 12 10]  [CDAB 10 17 11]  [BCDA 11 22 12]
	set A [expr {$B + [<<< [expr {$A + (($B&$C)|((~$B)&$D)) + [lindex $X 8]  + [lindex $T 9] }]  7]}]
	set D [expr {$A + [<<< [expr {$D + (($A&$B)|((~$A)&$C)) + [lindex $X 9]  + [lindex $T 10]}] 12]}]
	set C [expr {$D + [<<< [expr {$C + (($D&$A)|((~$D)&$B)) + [lindex $X 10] + [lindex $T 11]}] 17]}]
	set B [expr {$C + [<<< [expr {$B + (($C&$D)|((~$C)&$A)) + [lindex $X 11] + [lindex $T 12]}] 22]}]
	# [ABCD 12  7 13]  [DABC 13 12 14]  [CDAB 14 17 15]  [BCDA 15 22 16]
	set A [expr {$B + [<<< [expr {$A + (($B&$C)|((~$B)&$D)) + [lindex $X 12] + [lindex $T 13]}]  7]}]
	set D [expr {$A + [<<< [expr {$D + (($A&$B)|((~$A)&$C)) + [lindex $X 13] + [lindex $T 14]}] 12]}]
	set C [expr {$D + [<<< [expr {$C + (($D&$A)|((~$D)&$B)) + [lindex $X 14] + [lindex $T 15]}] 17]}]
	set B [expr {$C + [<<< [expr {$B + (($C&$D)|((~$C)&$A)) + [lindex $X 15] + [lindex $T 16]}] 22]}]

	# Round 2.
	# Let [abcd k s i] denote the operation
	#      a = b + ((a + G(b,c,d) + X[k] + T[i]) <<< s).
	# Do the following 16 operations.
	# [ABCD  1  5 17]  [DABC  6  9 18]  [CDAB 11 14 19]  [BCDA  0 20 20]
	set A [expr {$B + [<<< [expr {$A + (($B&$D)|($C&(~$D))) + [lindex $X 1]  + [lindex $T 17]}]  5]}]
	set D [expr {$A + [<<< [expr {$D + (($A&$C)|($B&(~$C))) + [lindex $X 6]  + [lindex $T 18]}]  9]}]
	set C [expr {$D + [<<< [expr {$C + (($D&$B)|($A&(~$B))) + [lindex $X 11] + [lindex $T 19]}] 14]}]
	set B [expr {$C + [<<< [expr {$B + (($C&$A)|($D&(~$A))) + [lindex $X 0]  + [lindex $T 20]}] 20]}]
	# [ABCD  5  5 21]  [DABC 10  9 22]  [CDAB 15 14 23]  [BCDA  4 20 24]
	set A [expr {$B + [<<< [expr {$A + (($B&$D)|($C&(~$D))) + [lindex $X 5]  + [lindex $T 21]}]  5]}]
	set D [expr {$A + [<<< [expr {$D + (($A&$C)|($B&(~$C))) + [lindex $X 10] + [lindex $T 22]}]  9]}]
	set C [expr {$D + [<<< [expr {$C + (($D&$B)|($A&(~$B))) + [lindex $X 15] + [lindex $T 23]}] 14]}]
	set B [expr {$C + [<<< [expr {$B + (($C&$A)|($D&(~$A))) + [lindex $X 4]  + [lindex $T 24]}] 20]}]
	# [ABCD  9  5 25]  [DABC 14  9 26]  [CDAB  3 14 27]  [BCDA  8 20 28]
	set A [expr {$B + [<<< [expr {$A + (($B&$D)|($C&(~$D))) + [lindex $X 9]  + [lindex $T 25]}]  5]}]
	set D [expr {$A + [<<< [expr {$D + (($A&$C)|($B&(~$C))) + [lindex $X 14] + [lindex $T 26]}]  9]}]
	set C [expr {$D + [<<< [expr {$C + (($D&$B)|($A&(~$B))) + [lindex $X 3]  + [lindex $T 27]}] 14]}]
	set B [expr {$C + [<<< [expr {$B + (($C&$A)|($D&(~$A))) + [lindex $X 8]  + [lindex $T 28]}] 20]}]
	# [ABCD 13  5 29]  [DABC  2  9 30]  [CDAB  7 14 31]  [BCDA 12 20 32]
	set A [expr {$B + [<<< [expr {$A + (($B&$D)|($C&(~$D))) + [lindex $X 13] + [lindex $T 29]}]  5]}]
	set D [expr {$A + [<<< [expr {$D + (($A&$C)|($B&(~$C))) + [lindex $X 2]  + [lindex $T 30]}]  9]}]
	set C [expr {$D + [<<< [expr {$C + (($D&$B)|($A&(~$B))) + [lindex $X 7]  + [lindex $T 31]}] 14]}]
	set B [expr {$C + [<<< [expr {$B + (($C&$A)|($D&(~$A))) + [lindex $X 12] + [lindex $T 32]}] 20]}]

	# Round 3.
	# Let [abcd k s t] [sic] denote the operation
	#     a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s).
	# Do the following 16 operations.
	# [ABCD  5  4 33]  [DABC  8 11 34]  [CDAB 11 16 35]  [BCDA 14 23 36]
	set A [expr {$B + [<<< [expr {$A + ($B^$C^$D) + [lindex $X 5]  + [lindex $T 33]}]  4]}]
	set D [expr {$A + [<<< [expr {$D + ($A^$B^$C) + [lindex $X 8]  + [lindex $T 34]}] 11]}]
	set C [expr {$D + [<<< [expr {$C + ($D^$A^$B) + [lindex $X 11] + [lindex $T 35]}] 16]}]
	set B [expr {$C + [<<< [expr {$B + ($C^$D^$A) + [lindex $X 14] + [lindex $T 36]}] 23]}]
	# [ABCD  1  4 37]  [DABC  4 11 38]  [CDAB  7 16 39]  [BCDA 10 23 40]
	set A [expr {$B + [<<< [expr {$A + ($B^$C^$D) + [lindex $X 1]  + [lindex $T 37]}]  4]}]
	set D [expr {$A + [<<< [expr {$D + ($A^$B^$C) + [lindex $X 4]  + [lindex $T 38]}] 11]}]
	set C [expr {$D + [<<< [expr {$C + ($D^$A^$B) + [lindex $X 7]  + [lindex $T 39]}] 16]}]
	set B [expr {$C + [<<< [expr {$B + ($C^$D^$A) + [lindex $X 10] + [lindex $T 40]}] 23]}]
	# [ABCD 13  4 41]  [DABC  0 11 42]  [CDAB  3 16 43]  [BCDA  6 23 44]
	set A [expr {$B + [<<< [expr {$A + ($B^$C^$D) + [lindex $X 13] + [lindex $T 41]}]  4]}]
	set D [expr {$A + [<<< [expr {$D + ($A^$B^$C) + [lindex $X 0]  + [lindex $T 42]}] 11]}]
	set C [expr {$D + [<<< [expr {$C + ($D^$A^$B) + [lindex $X 3]  + [lindex $T 43]}] 16]}]
	set B [expr {$C + [<<< [expr {$B + ($C^$D^$A) + [lindex $X 6]  + [lindex $T 44]}] 23]}]
	# [ABCD  9  4 45]  [DABC 12 11 46]  [CDAB 15 16 47]  [BCDA  2 23 48]
	set A [expr {$B + [<<< [expr {$A + ($B^$C^$D) + [lindex $X 9]  + [lindex $T 45]}]  4]}]
	set D [expr {$A + [<<< [expr {$D + ($A^$B^$C) + [lindex $X 12] + [lindex $T 46]}] 11]}]
	set C [expr {$D + [<<< [expr {$C + ($D^$A^$B) + [lindex $X 15] + [lindex $T 47]}] 16]}]
	set B [expr {$C + [<<< [expr {$B + ($C^$D^$A) + [lindex $X 2]  + [lindex $T 48]}] 23]}]

	# Round 4.
	# Let [abcd k s t] [sic] denote the operation
	#     a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s).
	# Do the following 16 operations.
	# [ABCD  0  6 49]  [DABC  7 10 50]  [CDAB 14 15 51]  [BCDA  5 21 52]
	set A [expr {$B + [<<< [expr {$A + ($C^($B|~$D)) + [lindex $X 0]  + [lindex $T 49]}]  6]}]
	set D [expr {$A + [<<< [expr {$D + ($B^($A|~$C)) + [lindex $X 7]  + [lindex $T 50]}] 10]}]
	set C [expr {$D + [<<< [expr {$C + ($A^($D|~$B)) + [lindex $X 14] + [lindex $T 51]}] 15]}]
	set B [expr {$C + [<<< [expr {$B + ($D^($C|~$A)) + [lindex $X 5]  + [lindex $T 52]}] 21]}]
	# [ABCD 12  6 53]  [DABC  3 10 54]  [CDAB 10 15 55]  [BCDA  1 21 56]
	set A [expr {$B + [<<< [expr {$A + ($C^($B|~$D)) + [lindex $X 12] + [lindex $T 53]}]  6]}]
	set D [expr {$A + [<<< [expr {$D + ($B^($A|~$C)) + [lindex $X 3]  + [lindex $T 54]}] 10]}]
	set C [expr {$D + [<<< [expr {$C + ($A^($D|~$B)) + [lindex $X 10] + [lindex $T 55]}] 15]}]
	set B [expr {$C + [<<< [expr {$B + ($D^($C|~$A)) + [lindex $X 1]  + [lindex $T 56]}] 21]}]
	# [ABCD  8  6 57]  [DABC 15 10 58]  [CDAB  6 15 59]  [BCDA 13 21 60]
	set A [expr {$B + [<<< [expr {$A + ($C^($B|~$D)) + [lindex $X 8]  + [lindex $T 57]}]  6]}]
	set D [expr {$A + [<<< [expr {$D + ($B^($A|~$C)) + [lindex $X 15] + [lindex $T 58]}] 10]}]
	set C [expr {$D + [<<< [expr {$C + ($A^($D|~$B)) + [lindex $X 6]  + [lindex $T 59]}] 15]}]
	set B [expr {$C + [<<< [expr {$B + ($D^($C|~$A)) + [lindex $X 13] + [lindex $T 60]}] 21]}]
	# [ABCD  4  6 61]  [DABC 11 10 62]  [CDAB  2 15 63]  [BCDA  9 21 64]
	set A [expr {$B + [<<< [expr {$A + ($C^($B|~$D)) + [lindex $X 4]  + [lindex $T 61]}]  6]}]
	set D [expr {$A + [<<< [expr {$D + ($B^($A|~$C)) + [lindex $X 11] + [lindex $T 62]}] 10]}]
	set C [expr {$D + [<<< [expr {$C + ($A^($D|~$B)) + [lindex $X 2]  + [lindex $T 63]}] 15]}]
	set B [expr {$C + [<<< [expr {$B + ($D^($C|~$A)) + [lindex $X 9]  + [lindex $T 64]}] 21]}]

	# Then perform the following additions. (That is increment each
	#   of the four registers by the value it had before this block
	#   was started.)
	incr A $AA
	incr B $BB
	incr C $CC
	incr D $DD
    }
    # 3.5 Step 5. Output

    # ... begin with the low-order byte of A, and end with the high-order byte
    # of D.

    binary format iiii $A $B $C $D
}


# bitwise left-rotate
proc md5pure::<<< {x i} {
    # This works by bitwise-ORing together right piece and left
    # piece so that the (original) right piece becomes the left
    # piece and vice versa.
    #
    # The (original) right piece is a simple left shift.
    # The (original) left piece should be a simple right shift
    # but Tcl does sign extension on right shifts so we
    # shift it 1 bit, mask off the sign, and finally shift
    # it the rest of the way.

    expr {($x << $i) | ((($x >> 1) & 0x7fffffff) >> (31-$i))}
}

#proc md5pure::F {x y z} {expr {(($x & $y) | ((~$x) & $z))}}
#proc md5pure::G {x y z} {expr {(($x & $z) | ($y & (~$z)))}}
#proc md5pure::H {x y z} {expr {$x ^ $y ^ $z}}
#proc md5pure::I {x y z} {expr {$y ^ ($x | (~$z))}}

#proc md5pure::byte0 {i} {expr {0xff & $i}}
#proc md5pure::byte1 {i} {expr {(0xff00 & $i) >> 8}}
#proc md5pure::byte2 {i} {expr {(0xff0000 & $i) >> 16}}
#proc md5pure::byte3 {i} {expr {((0xff000000 & $i) >> 24) & 0xff}}

#proc md5pure::bytes {i} {
#    format %0.2x%0.2x%0.2x%0.2x [byte0 $i] [byte1 $i] [byte2 $i] [byte3 $i]
#}

# hmac: hash for message authentication
proc md5pure::hmac {key text} {
    # if key is longer than 64 bytes, reset it to MD5(key).  If shorter, 
    # pad it out with null (\x00) chars.
    set keyLen [string length $key]
    if {$keyLen > 64} {
        set key [md5 $key]
        set keyLen [string length $key]
    }

    # ensure the key is padded out to 64 chars with nulls.
    set padLen [expr {64 - $keyLen}]
    append key [binary format "a$padLen" {}]

    # Split apart the key into a list of 16 little-endian words
    binary scan $key i16 blocks

    # XOR key with ipad and opad values
    set k_ipad {}
    set k_opad {}
    foreach i $blocks {
        append k_ipad [binary format i [expr {$i ^ 0x36363636}]]
        append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]]
    }
    
    # Perform inner md5, appending its results to the outer key
    append k_ipad $text
    append k_opad [md5 $k_ipad]

    # Perform outer md5
    binary scan [md5 $k_opad] H* result
    return $result
}

package provide md5pure 1.2

Added parse.tcl.




































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
#! /usr/local/bin/tclsh8.0

# Regular expressions - suitable for 8.0 as well as later.
set ws "\[ \t\n\]"
set ParSepRE      "^$ws*$"
set RFC822ContRE  "^$ws"
set RFC822DataRE  "^(\[^ \t:\]+):$ws+(.*)$"
set RFC822EmptyRE "^(\[^ \t:\]+):$"
set ItemNoLeadRE  "^\[^ \t>\]"
set ItemLeadRE "^$ws*((>$ws+)*)(\\*|\[0-9\]+\\.|(\[^\t\n:\]|:\[^:\t\n\])+:)$ws"
set ItemContRE "^($ws+>)+$ws*"
# RE's for (optional) use in paragraphs
set AuthorRE "(.*$ws+)?<(\[^:@\][email protected]\[^:@\]+)>"
set ImageRE "^(\[^ \t\n\]+)$ws*(.*)$"
set EmailRE {<([^<>@][email protected][^<>@]+)>}
set URLRE {(https?|ftp|news(rc)?|mailto|gopher):([-A-Za-z0-9/_:.%#[email protected]?=&;~\\]+)}
set TIPURLRE {tip:([0-9]+)}
set ShortTIPRE {\[([0-9]+)\]}
set ISSUEURLRE {issue:([0-9]+)}

# # Regular expressions - suitable for 8.1 and later only. It is easier to
# # understand the above by looking at the below and translating...  :^)
# 
# set ParSepRE      {^\s*$}
# set RFC822ContRE  {^\s}
# set RFC822DataRE  {^([^\s:]+):\s*(.*)$}
# set RFC822EmptyRE {^([^\s:]+):\s*$}
# set ItemNoLeadRE  {^[\s>]}
# set ItemLeadRE    {^\s*((>\s+)*)(\*|\d+\.|(?:[^\t\n:]|:(?=\S))+:)\s}
# set ItemContRE    {^(\s+>)+\s*}
# # RE's for (optional) use in paragraphs
# set AuthorRE {(.*\s+)?<(.*[email protected]*)>}
# set ImageRE {^(\S+)\s*(.*)$}
# set EmailRE {<([^<>@][email protected][^<>@]+)>}
# set URLRE {(https?|ftp|news(?:rc)?|mailto|gopher):([-A-Za-z0-9/_:.#[email protected]?=&;~\\]+)}
# set TIPURLRE {tip:(\d+)}
# set ShortTIPRE {\[(\d+)\]}
# set ISSUEURLRE {issue:(\d+)}
# 
# # Note that ItemLeadRE would be clearer if written as:
# #     ^\s*((?:>\s+)*)(\*|\d+\.|(?:[^\t\n:]|:(?=\S))+:)\s
# # but that would be incompatible with the 8.0 version.

proc splitIntoParagraphs {string} {
    global ParSepRE
    set paragraphs {}
    set current {}
    foreach line [split $string "\n"] {
	if {[regexp $ParSepRE $line]} {
	    # (VISUALLY) BLANK LINE = PARAGRAPH SEPARATOR
	    if {[string length $current]} {
		lappend paragraphs [string trim $current "\n"]
		set current {}
	    }
	    continue
	}
	append current "\n$line"
    }
    if {[string length $current]} {
	lappend paragraphs [string trim $current "\n"]
    }
    return $paragraphs
}

proc splitRFC822Header {paragraph} {
    global RFC822ContRE RFC822DataRE RFC822EmptyRE
    set properlines {}
    set current {}
    foreach line [split $paragraph "\n"] {
	if {[regexp $RFC822ContRE $line]} {
	    append current $line
	    continue
	}
	if {[string length $current]} {
	    if {[regexp $RFC822DataRE $current -> tag value]} {
		lappend properlines $tag $value
	    } elseif {[regexp $RFC822EmptyRE $current -> tag]} {
		lappend properlines $tag {}
	    } else {
		return -code error "header \"$current\" malformatted"
	    }
	}
	set current $line
    }
    if {[string length $current]} {
	if {[regexp $RFC822DataRE $current -> tag value]} {
	    lappend properlines $tag $value
	} elseif {[regexp $RFC822EmptyRE $current -> tag]} {
	    lappend properlines $tag {}
	} else {
	    return -code error "header \"$current\" malformatted"
	}
    }
    return $properlines
}

proc TIPHeaderSpecification {permitted required} {
    upvar 1 $permitted formatREs $required neededHeaders
    # A header is only permitted if it is a key in this array, and the value
    # in the array is the regexp that the value in the field (after
    # un-stuffing) must satisfy.
    array set formatREs {
	TIP		{^[0-9]+$}
	Title		{.}
	Version		{^\$.*\$ *$}
	Author		{<[email protected]+\..+>}
	State		{^(Draft|Active|Accepted|Deferred|Final|Rejected|Withdrawn)$}
	Type		{^(Process|Project|Informati(ve|on(al)?))$}
	Vote		{^(Pending|In progress|Done|No voting)$}
	Created		{^[0-3][0-9]-[A-Z][a-z][a-z]-2[0-9][0-9][0-9]$}
	Post-History	{.*}
	Tcl-Version	{^[0-9]+\.[0-9]+([ab.][0-9]+)?$}
	Discussions-To	{.}
	Obsoletes	{^[0-9]+$}
	Obsoleted-By	{^[0-9]+$}
	Keywords	{.}
	Vote-By		{^[0-9]+$}
	Voted-For	{.}
	Voted-Against	{.}
	Voted-Abstained	{.}
    }
    # A list of headers that *must* be present in a conforming TIP.
    set neededHeaders {
	TIP Title Version Author State Type Vote Created Post-History
    }
    ## Headers that may occur multiple times in a conforming TIP. All others
    ## must occur at most once.
    #set multipleHeaders {
    #	 Author
    #}
}

# takes output of splitRFC822Header
proc verifyTIPheader {headerlines} {
    array set headers {}
    TIPHeaderSpecification permitted required

    foreach {tag value} $headerlines {
	if {![info exists permitted($tag)]} {
	    return -code error "header \"${tag}: $value\" not understood"
	}
	if {![regexp $permitted($tag) $value]} {
	    return -code error "header \"${tag}: $value\" malformatted"
	}
	if {[string compare $tag Author]} {
	    if {[info exists headers($tag)]} {
		return -code error "header for \"${tag}:\" can only occur once"
	    }
	    set headers($tag) $value
	} else {
	    lappend headers($tag) $value
	}
    }
    foreach tag $required {
	if {![info exist headers($tag)]} {
	    return -code error "header for \"${tag}:\" is required"
	}
    }
    if {[string match Info* $headers(Type)]} {
	set headers(Type) Informative
    }
    if {[info exist headers(Keywords)]} {
	set kws {}
	foreach keyword [split $headers(Keywords) ","] {
	    regsub -all "\[ \t\n\]+" $keyword " " keyword
	    lappend kws [string trim $keyword]
	}
	set headers(Keywords) $kws
    }
    # This check is complex...
    if {[info exist headers(Tcl-Version)] != ![string compare $headers(Type) Project]} {
	return -code error "header \"Tcl-Version:\" iff a project TIP"
    }
    # Force the created header into processable form
    regsub -all -- (.+)-(.+)-(.+) $headers(Created) {\2 \1, \3} date
    set headers(Created) [clock scan $date -gmt 1]
    # Now return as association list
    return [array get headers]
}

proc makeHeaderLine {tag value} {
    set line $tag:
    set numSpaces [expr {16 - [string length $tag]}]
    while {[incr numSpaces -1]} {
        append line " "
    }
    append line $value
    return $line
}

proc constructTIPHeader {headerData} {
    array set headers $headerData
    # Remove RawAbstract, Abstract and Body entries, if any
    catch {unset headers(RawAbstract)}
    catch {unset headers(Abstract)}
    catch {unset headers(Body)}

    TIPHeaderSpecification permitted required
    set headerLines [list]
    foreach tag $required {
	if {![info exists headers($tag)]} {
	    return -code error "header for \"${tag}\" is required"
	}
	set value $headers($tag)
	# Created tag needs restoration to standard form
	if {[string match Created $tag]} {
	    set value [clock format $value -format %d-%b-%Y -gmt 1]
	}
	if {![regexp $permitted($tag) $value]} {
	    return -code error "header \"${tag}: $value\" malformatted"
	}
	# Author tag needs special handling
	if {[string match Author $tag]} {
	    foreach author $value {
		if {![regexp $permitted($tag) $author]} {
		    return -code error "header \"${tag}: $value\" malformatted"
		}
		lappend headerLines [makeHeaderLine Author $author]
	    }
	    unset headers($tag)
	    continue
	}
	lappend headerLines [makeHeaderLine $tag $value]
	unset headers($tag)
    }
    foreach tag [lsort [array names headers]] {
	if {![info exists permitted($tag)]} {
	    return -code error "header \"${tag}: $value\" not understood"
	}
	set value $headers($tag)
	if {![regexp $permitted($tag) $value]} {
	    return -code error "header \"${tag}: $value\" malformatted"
	}
	if {[string match Keywords $tag]} {
	    lappend headerLines [makeHeaderLine $tag [join $value ","]]
	} else {
	    lappend headerLines [makeHeaderLine $tag $value]
	}
    }
    return [join $headerLines \n]
}

proc notEditable? {headerArray} {
    upvar 1 $headerArray h
    expr {[string compare Draft $h(State)]||[string compare Pending $h(Vote)]}
}

proc shortspc {string} {
    regsub -all {[ 	
    ]+} $string " " string
    return $string
}
proc intuitParagraphKind {paragraph} {
    switch -glob -- $paragraph {
	~* {
	    # easier to express in 8.1 as {^((?:~ *){1,3})(.*)}
	    regexp {^(~( *~)?( *~)?) *(.*)$} $paragraph -> \
		    levelmark ? ? content
	    # Count the number of tildes in the level-mark
	    set level [regsub -all ~ $levelmark x levelmark]
	    return [list section [string trim [shortspc $content]] $level]
	}
	|* {
	    set lines {}
	    foreach line [split $paragraph "\n"] {
		if {![string match |* $line]} {
		    variable DEBUG_VERBATIM
		    if {$DEBUG_VERBATIM} {
			return -code error "malformatted verbatim line \"$line\""
		    }
		    lappend lines $line
		} else {
		    lappend lines [string range $line 1 end]
		}
	    }
	    return [list verbatim $lines]
	}
	#index:* {
	    set type [string trim [string range $paragraph 7 end]]
	    if {![string length $type]} {set type medium}
	    return [list index $type]
	}
	#image:* {
	    return [list image [string range $paragraph 7 end]]
	}
	---- {
	    return {separator}
	}
    }

    global ItemNoLeadRE ItemLeadRE ItemContRE

    # Hmm.  Need to figure out if we've got a list item of some kind.
    if {[regexp $ItemNoLeadRE $paragraph]} {
	return [list ordinary [shortspc $paragraph]]
    }
    if {[regexp $ItemLeadRE $paragraph head continuation ? kind]} {
        set content [string range $paragraph [string length $head] end]
        set level [llength $continuation]
        switch -glob -- $kind {
	    *: {
		set kind [string trimright $kind ":"]
		return [list description $kind $level [shortspc $content]]
	    }
	    *. {
		set kind [string trimright $kind "."]
		return [list enumeration $kind $level [shortspc $content]]
	    }
	}
	return [list bulleting $level [shortspc $content]]
    }
    if {[regexp $ItemContRE $paragraph head]} {
	set content [string range $paragraph [string length $head] end]
	return [list continuation [llength $head] [shortspc $content]]
    }
    return [list ordinary [shortspc $paragraph]]
}

array set contentsCache {}
proc getTIPFileContents {filename} {
    global contentsCache
    if {[info exist contentsCache($filename)]} {
	return $contentsCache($filename)
    }
    set f [open $filename r]
    set content [read $f [file size $filename]]
    close $f
    set contentsCache($filename) $content
}
proc readTIPDetailsFromFile {filename} {
    variable DEBUG_VERBATIM
    if {![info exist DEBUG_VERBATIM]} {
	set DEBUG_VERBATIM 0
    }
    set pars [splitIntoParagraphs [getTIPFileContents $filename]]
    foreach {headers title abstract} $pars {break}
    set heads [verifyTIPheader [splitRFC822Header $headers]]
    if {[string compare [intuitParagraphKind $title] {section Abstract 1}]} {
	error "Must start with abstract..."
    }
    lappend heads Abstract [lindex [intuitParagraphKind $abstract] 1]
    lappend heads RawAbstract $abstract
    lappend heads Body [lrange $pars 3 end]
}
array set tipdetails {}
proc getTIPDetails {filename} {
    global tipdetails contentsCache
    if {![info exist tipdetails(time:$filename)]
	|| ([file mtime $filename] > $tipdetails(time:$filename))} {
	set tipdetails(time:$filename) [file mtime $filename]
	catch {unset contentsCache($filename)}
	set tipdetails(file:$filename) [readTIPDetailsFromFile $filename]
    }
    return $tipdetails(file:$filename)
}
proc getTIPFilenames {} {
    global DOCDIR FEATURE TESTINGTIP
    cd $DOCDIR
    set tips [lsort -dictionary [glob *.tip]]
    # Assume the testing TIP (only visible when editing enabled) is at end!
    if {
	!$FEATURE(EDIT) &&
	![string compare [lindex $tips end] ${TESTINGTIP}.tip]
    } then {
	# Don't remove TIP 10000 if editing is enabled.
	set tips [lreplace $tips end end]
    }
    return $tips
}
proc foreachTIP {arrayname script} {
    upvar 1 $arrayname ary
    foreach file [getTIPFilenames] {
	array set ary [getTIPDetails $file]
	uplevel 1 $script
	unset ary
    }
}
proc foreachTIPreverse {arrayname script} {
    upvar 1 $arrayname ary
    set files [getTIPFilenames]
    for {set idx [llength $files]} {[incr idx -1] >= 0} {} {
	array set ary [getTIPDetails [lindex $files $idx]]
	uplevel 1 $script
	unset ary
    }
}

proc convert {in out {type html}} {
    set cwd [pwd]
    set document [formatTIPDocument [getTIPFileContents $in] $type]

    set fout [open [file join $cwd $out] w]
    puts -nonewline $fout $document
    flush $fout
    close $fout
}

proc formatTIPDocument {string {type html} args} {
    global SRCDIR
    set ns tip${type}
    source $SRCDIR/$ns.tcl

    variable DEBUG_VERBATIM
    if {![info exist DEBUG_VERBATIM]} {
	set DEBUG_VERBATIM 0
    }
    set pars  [splitIntoParagraphs $string]
    set heads [verifyTIPheader [splitRFC822Header [lindex $pars 0]]]
    set par1  [intuitParagraphKind [lindex $pars 1]]
    if {[string compare $par1 {section Abstract 1}]} {
	array set h $heads
	return -code error "TIP $h(TIP) must start with abstract..."
    }

    global convert
    set convert {}
    proc ${ns}::puts {args} {
	global convert
	switch [llength $args] {
	    2 {append convert [lindex $args 1]}
	    1 {append convert [lindex $args 0] "\n"}
	}
    }
    if {[llength $args]} {
	${ns}::generateDocument $heads [lrange $pars 1 end] $args
    } else {
	${ns}::generateDocument $heads [lrange $pars 1 end]
    }

    return $convert
}

if {![info exist SRCDIR]} {
    set SRCDIR     [file join [pwd] [file dirname [info script]]]
    source $SRCDIR/config.tcl

    append convertRE {^([0-9]+).} ([join $renderexts |]) {$}
    if {[regexp $convertRE [lindex $argv 0] out id type]} {
	catch {
	    set src [file join $DOCDIR $id.tip]
	    puts -nonewline "converting $src to $out..."
	    flush stdout
	    convert $src $out $type
	    puts " done"
	    exit
	}
	puts $errorInfo
	exit 1
    }
}

Added post.tcl.


































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
# FILE: post.tcl
#
# Routines to process the HTTP POST method, gathering HTML form input
# values from stdin, and storing it in namespace variables post::* .

namespace eval post {
    variable operation edit
    variable email ""
    variable name ""
}

proc post::UrlDecode {str} {
    regsub -all {\+} $str { } str
    regsub -all {[][\\\$]} $str {\\&} str
    regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $str {[format %c 0x\1]} str
    set str [subst $str]
    regsub -all "\r\n" $str "\n" str
    return $str
}

# Local variables in this proc have a leading underscore so they do
# not interfere with the namespace variables.
proc post::getVars {{env env}} {
    upvar #0 $env _e
    upvar #0 URI _URI

    if {![info exists _e(CONTENT_TYPE)]} {
	generr "Bad Request" "the request $_e(REQUEST_METHOD) for URL\
		$_URI did not provide a Content-Type." {} 400
    }
    if {![info exists _e(CONTENT_LENGTH)] 
	    || ![regexp {^[0-9]+$} [string trim $_e(CONTENT_LENGTH)]]} {
	generr "Bad Request" "the request $_e(REQUEST_METHOD) for URL\
		$_URI did not provide a valid Content-Length." {} 411
    }
    if {[string compare application/x-www-form-urlencoded $_e(CONTENT_TYPE)]} {
	generr "Unsupported Request" "the request $_e(REQUEST_METHOD) for URL\
		$_URI provided Content-Type '$_e(CONTENT_TYPE)' instead of \
		'application/x-www-form-urlencoded'." {} 415
    }
    set _query [read stdin $_e(CONTENT_LENGTH)]
    foreach _def [split $_query &] {
	set _pair [split $_def =]
	if {[llength $_pair] != 2} {
	    generr "Bad Request" "the request $_e(REQUEST_METHOD) for URL\
		$_URI provided improperly encoded form data" {} 400
	}
	set _varName [UrlDecode [lindex $_pair 0]]
	if {[string match _* $_varName]} {
	    generr "Forbidden Request" "the request $_e(REQUEST_METHOD) for\
		URL $_URI provided form variables with leading underscores." \
		{} 403
	}
	if {[regexp {[^a-zA-Z0-9_]} $_varName]} {
	    generr "Forbidden Request" "the request $_e(REQUEST_METHOD) for\
		URL $_URI provided form variables containing non-alphanumeric\
		characters." {} 403
	}
	variable $_varName
	set $_varName [UrlDecode [lindex $_pair 1]]
    }

    # Disable multiple calls of this command
    rename [lindex [info level 0] 0] {}
} 

Added postnews.tcl.
































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
#! /bin/sh
#\
exec tclsh "$0" ${1+"[email protected]"}

set SRCDIR [file join [pwd] [file dirname $argv0]]
source $SRCDIR/config.tcl
source $SRCDIR/parse.tcl
source $SRCDIR/md5.tcl
source $SRCDIR/base64.tcl
source $SRCDIR/post.tcl
source $SRCDIR/mail.tcl

binary scan [binary format f [pid].[clock seconds]] I uniquePart

proc MD5inB64 {str} {
    return [B64encode [md5pure::md5 $str] 128]
}

proc generateNewsMessage {tipnumber extra} {
    global DOCDIR PUBLISHURL FEATURE FOOTERTEXT ENGINEURL TCLCOREMAIL
    global opts uniquePart
    set tipfile [file join $DOCDIR $tipnumber.tip]
    set docurl  $PUBLISHURL/$tipnumber.html
    set editurl $PUBLISHURL/edit/$tipnumber

    puts stderr "Loading TIP from $tipfile"
    array set h [getTIPDetails $tipfile]
    set tip [getTIPFileContents $tipfile]

    puts stderr "Generating plain text body"
    if {$FEATURE(EDIT_URL_IN_NEWS_MESSAGE)} {
	set body [formatTIPDocument $tip txt URL $docurl WebEdit $editurl]
    } else {
	set body [formatTIPDocument $tip txt URL $docurl]
    }

    puts stderr "Generating body md5 digest"
    set digest [MD5inB64 $body]

    puts stderr "Generating headers"
    append content \
	    "MIME-Version: 1.0\n" \
	    "Content-Type: text/plain; charset=iso-8859-1\n" \
	    "Content-Transfer-Encoding: 8bit\n" \
	    "Content-MD5: $digest\n"
    append content [clock format [clock seconds] -gmt 1 -format \
	    "Date: %a, %d %b %Y %H:%M:%S +0000\n"]
    append content [format "Message-Id: <tip%d.%[email protected]%s>\n" \
	    $tipnumber $uniquePart [info hostname]]
    if {[llength $extra]} {
	append content "Subject: [join $extra] TIP #$h(TIP): $h(Title)\n"
    } else {
	append content "Subject: TIP #$h(TIP): $h(Title)\n"
    }
    regsub -all "\t" [lindex $h(Author) 0] " " a0
    regsub {^(.*[.].*[^ ]) +<(.+)>$} $a0 {"\1" <\2>} a0
    append content \
	    "Sender: TIP Editor <[email protected]>\n" \
	    "From: [string trim $a0]\n" \
	    "Errors-To: [email protected]\n"
    if {$opts(news)} {
	append content \
		"Newsgroups: comp.lang.tcl,comp.lang.tcl.announce\n" \
		"To: [email protected]\n" \
		"Reply-To: [string trim $a0]\n" \
		"Followup-To: comp.lang.tcl\n"
	# Some software seems to insist on sending email messages to
	# me in response to TIPs; this is just about as bogus as you
	# can get.  However, mail in general provides no way to say
	# that you want administrative stuff going to one address,
	# and subject-matter related stuff going to another.  This
	# sucks...
	###append content "Reply-To: $TCLCOREMAIL\n"
	set opts(news) 0
    } elseif {$opts(list)} {
	append content \
		"To: $TCLCOREMAIL\n" \
		"Reply-To: $TCLCOREMAIL\n"
	set opts(list) 0
	if {$opts(author)} {
	    set opts(author) 0
	    foreach author $h(Author) {
		regsub {^(.*[.].*[^ ]) +<(.+)>$} $author {"\1" <\2>} author
		append content "Cc: $author\n"
	    }
	}
	foreach extraAddress $opts(extra) {
	    append content "Cc: $extraAddress\n"
	}
	set opts(extra) {}
    } elseif {$opts(author)} {
	set opts(author) 0
	foreach author $h(Author) {
	    regsub {^(.*[.].*[^ ]) +<(.+)>$} $author {"\1" <\2>} author
	    append content "To: $author\n"
	}
	foreach extraAddress $opts(extra) {
	    append content "Cc: $extraAddress\n"
	}
	set opts(extra) {}
    }
    append content \
	    "Organization: Tcl Core Team\n" \
	    "X-Generated-By: $FOOTERTEXT\n" \
	    "X-Generator-Url: $ENGINEURL\n"
    if {[info exist h(Keywords)]} {
	append content "Keywords: [join $h(Keywords) {, }]\n"
    }
    append content "\n" $body

    puts stderr "Posting message"
    return $content
}

if {!$FEATURE(PUBLISHING)} {
    puts stderr "Sorry, but this installation does not support\
	    publishing of TIPs"
    exit 1
}

proc preset {ary name value} {
    upvar $ary a
    if {![info exist a($name)]} {
	set a($name) $value
    }
}
proc shift {{n 1}} {
    global argv
    set shifted [lrange $argv 0 [expr $n-1]]
    set argv [lrange $argv $n end]
    return $shifted
}

proc main {} {
    global argc argv opts argv0 TCLCOREMAIL
    if {$argc == 0} {
	puts stderr "usage: [file tail $argv0] ?options? ?--? tipNumber"
	puts stderr "Supported options are:"
	puts stderr "\t-news\t Posts to comp.lang.tcl and comp.lang.tcl.announce"
	puts stderr "\t-list\t Posts to $TCLCOREMAIL mailing list."
	puts stderr "\t-author\t Sends a copy to the (first) author of the TIP."
	puts stderr "\t-extra address"
	puts stderr "\t\t Sends the publishing message to an extra email address"
	puts stderr "\t\t (e.g. a mailing list where people have a special interest"
	puts stderr "\t\t in the TIP.)  Multiple extra email addresses can be"
	puts stderr "\t\t specificied by using this option mulktiple times."
	puts stderr "\t-test\t Prevent all posting/mailing and prints formatted on"
	puts stderr "\t\t standard output (for debugging.)"
	puts stderr "\t--\t Marks the end of the options."
	exit
    }
    array set opts {}
    while {[llength $argv]} {
	switch -- [lindex $argv 0] {
	    -news   {set opts(news) 1}
	    -list   {set opts(list) 1}
	    -author {set opts(author) 1}
	    -test   {set opts(test) 1}
	    --      {shift; break}
	    -extra  {
		shift
		lappend opts(extra) [lindex $argv 0]
	    }
	    default {break}
	}
	shift
    }
    if {![array size opts]} {
	array set opts {
	    news 1  list 1  author 1  test 0  extra {}
	}
    } else {
	preset opts news   0
	preset opts list   0
	preset opts author 0
	preset opts test   0
	preset opts extra  {}
    }

    while {[lsearch [array get opts] 1] >= 0} {
	set message [generateNewsMessage [lindex $argv 0] [lrange $argv 1 end]]
	if {$opts(test)} {
	    puts $message
	    set opts(test) 0
	    break
	} else {
	    mail::mailsend $message 1
	}
    }
}
main
exit

Added quicktip.tcl.






























































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
#! /usr/local/bin/tclsh8.0

# Regular expressions - suitable for 8.0 as well as later.
set ws "\[ \t\n\]"
set ParSepRE      "^$ws*$"
set ItemNoLeadRE  "^\[^ \t>\]"
set ItemLeadRE    "^$ws*((>$ws+)*)(\\*|\[0-9\]+\\.|\[^\t\n:\]+:)$ws"
set ItemContRE    "^($ws+>)+$ws*"
set EmailRE       {<([^<>@][email protected][^<>@]+)>}
# It took lots of experiment to develop this next RE...
set URLRE {(https?|ftp|news(rc)?|mailto|gopher):[-A-Za-z0-9/_:.#[email protected]?=&;~\\]+}

# ----------------------------------------------------------------------

proc splitIntoParagraphs {string} {
    global ParSepRE
    set paragraphs {}
    set current {}
    foreach line [split $string "\n"] {
	if {[regexp $ParSepRE $line]} {
	    # (VISUALLY) BLANK LINE = PARAGRAPH SEPARATOR
	    if {[string length $current]} {
		lappend paragraphs [string trim $current "\n"]
		set current {}
	    }
	    continue
	}
	append current "\n$line"
    }
    if {[string length $current]} {
	lappend paragraphs [string trim $current "\n"]
    }
    return $paragraphs
}

proc shortspc {string} {
    global ws
    regsub -all ${ws}+ $string " " string
    return $string
}
proc intuitParagraphKind {paragraph} {
    switch -glob -- $paragraph {
	~* {
	    set content [string range $paragraph 1 end]
	    return [list section [string trim [shortspc $content]]]
	}
	|* {
	    set lines {}
	    foreach line [split $paragraph "\n"] {
		if {![string match |* $line]} {
		    return -code error "malformatted verbatim line \"$line\""
		}
		lappend lines [string range $line 1 end]
	    }
	    return [list verbatim $lines]
	}
	#index:* {
	    set type [string trim [string range $paragraph 7 end]]
	    if {![string length $type]} {set type medium}
	    return [list index $type]
	}
	#image:* {
	    return [list image [string range $paragraph 7 end]]
	}
	---- {
	    return {separator}
	}
    }

    global ItemNoLeadRE ItemLeadRE ItemContRE

    # Hmm.  Need to figure out if we've got a list item of some kind.
    if {[regexp $ItemNoLeadRE $paragraph]} {
	return [list ordinary [shortspc $paragraph]]
    }
    if {[regexp $ItemLeadRE $paragraph head continuation ? kind]} {
        set content [string range $paragraph [string length $head] end]
        set level [llength $continuation]
        switch -glob -- $kind {
	    *: {
		set kind [string trimright $kind ":"]
		return [list description $kind $level [shortspc $content]]
	    }
	    *. {
		set kind [string trimright $kind "."]
		return [list enumeration $kind $level [shortspc $content]]
	    }
	}
	return [list bulleting $level [shortspc $content]]
    }
    if {[regexp $ItemContRE $paragraph head]} {
	set content [string range $paragraph [string length $head] end]
	return [list continuation [llength $head] [shortspc $content]]
    }
    return [list ordinary [shortspc $paragraph]]
}

# ----------------------------------------------------------------------

namespace eval tiphtml {
    variable curlev -1
    variable contexts {}
    proc enterlistcontext {level good bad1 bad2} {
	variable curlev
	variable contexts
	if {$level > $curlev} {
	    incr curlev
	    lappend contexts "</$good>"
	    puts -nonewline "<$good compact>"
	}
	switch [lindex $contexts end] "</$bad1>" - "</$bad2>" {
	    puts -nonewline [lindex $contexts end]
	    puts -nonewline "<$good compact>"
	    set contexts [lreplace $contexts end end "</$good>"]
	}
    }
    proc closecontext {{level -1}} {
	variable curlev
	variable contexts
	while {$level < $curlev} {
	    incr curlev -1
	    puts -nonewline [lindex $contexts end]
	    set contexts [lrange $contexts 0 [expr {[llength $contexts]-2}]]
	}
    }
    proc quoteLiteral {string} {
	# This would be better with [string map], but that's not in 8.0
	regsub -all &  $string {\&amp;}  string
	regsub -all <  $string {\&lt;}   string
	regsub -all >  $string {\&gt;}   string
	regsub -all \" $string {\&quot;} string
	return $string
    }

    proc section {title} {
	closecontext
	puts "<h2>[quoteLiteral $title]</h2>"
    }
    proc ordinary {string} {
	continuation -1 $string
    }
    proc bulleting {level body} {
	closecontext $level
	enterlistcontext $level ul ol dl
	puts -nonewline "<li>"
	continuation $level $body
    }
    proc description {tag level body} {
	closecontext $level
	enterlistcontext $level dl ol ul
	puts -nonewline "<dt>$tag</dt><dd>"
	continuation $level $body
    }
    proc enumeration {tag level body} {
	closecontext $level
	enterlistcontext $level ol dl ul
	if {$tag != 1} {
	    puts -nonewline "<li value=\"$tag\">"
	} else {
	    puts -nonewline "<li>"
	}
	continuation $level $body
    }
    proc continuation {level body} {
	global EmailRE URLRE
	closecontext $level
	regsub -all $EmailRE $body "\x81mailto:\\1\x82" body
	set body [quoteLiteral $body]

	regsub -all $URLRE $body "<a href=\"&\">&</a>" body

	regsub -all {''(('?[^'])+)''} $body "<em>\\1</em>" body
	regsub -all \x81 $body "\\&lt;" body
	regsub -all \x82 $body "\\&gt;" body
	variable curlev
	if {$curlev==-1 && $level==1} {
	    puts "<blockquote><p align=\"justify\">$body</p></blockquote>"
	} else {
	    puts "<p align=\"justify\">$body</p>"
	}
    }
    proc separator {} {
	closecontext
	puts "<hr>"
    }
    proc verbatim {lines} {
	puts "<pre>"
	foreach line $lines {
	    # HTML ignores formfeed chars, but we want to see them...
	    regsub -all { } [quoteLiteral $line] "<b><u>^L</u></b>" line
	    puts $line
	}
	puts -nonewline "</pre>"
    }

    proc index {kind} {
	closecontext
	puts "<p align=\"justify\"><font color=\"red\">Index\
		style \"$kind\" not yet supported!</font></p>"
    }
    proc image {bodytext} {
	closecontext
	puts "<p align=\"justify\"><font color=\"red\">Image\
		\"$bodytext\" not yet supported!</font></p>"
    }
    proc generateHTMLPars {body} {
	foreach par [splitIntoParagraphs $body] {
	    eval [intuitParagraphKind $par]
	}
    }
}

# ----------------------------------------------------------------------

if {[llength $argv]} {
    foreach arg $argv {
	set f [open $arg]
	tiphtml::generateHTMLPars [read $f]
	close $f
    }
} else {
    tiphtml::generateHTMLPars [read stdin]
}

Added stats.bybrowser.tcl.
































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
#! /bin/sh
# \
exec tclsh8.0 $0 ${1+"[email protected]"}

#awk '{$1=$2=$3=""; print}' ../TIP/log | sort | uniq -c | sort -n
#echo ---------------------------
#awk '{$1=$2=$3=""; print}' ../TIP/log | perl -ne 'do {print "IE\n"; next;} if /MSIE/; do {print "Netscape\n"; next;} if /Mozilla/; print "Other\n";' | sort | uniq -c | sort -n

set SRCDIR [file join [pwd] [file dirname [info script]]]
source $SRCDIR/config.tcl

set browsers {}
array set browsermap {}

set f [open $LOGFILE r]
while {[gets $f line] >= 0} {
    foreach {ip date name browser} [split $line "\t"] {break}
    regsub -all {[ 	]+} [string trim $browser] " " browser
    append browsermap($browser) .
}
close $f

foreach {name str} [array get browsermap] {
    lappend browsers [list [string length $str] $name]
}
unset browsermap
array set browsermap {IE 0  Netscape 0  Other 0}

foreach line [lsort -integer -index 0 $browsers] {
    foreach {count browser} $line {}
    puts [format "%6d  %s" $count $browser]
    switch -glob -- $browser {
	*MSIE*    {incr browsermap(IE) $count}
	*Mozilla* {incr browsermap(Netscape) $count}
	default   {incr browsermap(Other) $count}
    }
}
puts ---------------------------
set browsers {}
foreach {class count} [array get browsermap] {
    lappend browsers [list $count $class]
}
foreach line [lsort -integer -index 0 $browsers] {
    foreach {count class} $line {}
    puts [format "%6d  %s" $count $class]
}

exit 0

Added stats.bydomain.tcl.






































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
#! /bin/sh
# \
exec tclsh8.0 $0 ${1+"[email protected]"}

set SRCDIR [file join [pwd] [file dirname [info script]]]
source $SRCDIR/config.tcl

set ips {}
array set ipmap {}
set threshold 0
if {[llength $argv]} {
    set threshold [lindex $argv 0]
}

set f [open $LOGFILE r]
while {[gets $f line] >= 0} {
    foreach {ip date name browser} [split $line "\t"] {break}
    append ipmap([string trim $ip]) .
}
close $f

set NUMRE {([0-9]?[0-9]?[0-9])}
set DQRE "^$NUMRE\.$NUMRE\.$NUMRE\.$NUMRE$"

foreach {ip str} [array get ipmap] {
    set len [string length $str]
    set domain numeric/unknown
    if {$len > $threshold} {
	set host $ip
	catch {
	    set host [lindex [lindex [split [exec host $ip] "\n"] 0] 1]
	    if {![regexp $DQRE $host]||$a>255||$b>255||$c>255||$d>255} {
		set domain [join [lrange [split $host .] 1 end] .]
	    }
	}
    }
    append dommap($domain) $str
}
unset ipmap

foreach {domain str} [array get dommap] {
    lappend ips [list [string length $str] $domain]
}
unset dommap

foreach line [lsort -integer -index 0 $ips] {
    foreach {count domain} $line {}
    puts [format "%6d  %s" $count $domain]
}

exit 0

Added stats.byfile.tcl.




























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
#! /bin/sh
# \
exec tclsh8.0 $0 ${1+"[email protected]"}

#awk '{print $3}' ../TIP/log | sort | uniq -c | sort -n

set SRCDIR [file join [pwd] [file dirname [info script]]]
source $SRCDIR/config.tcl

set files {}
array set filemap {}

set f [open $LOGFILE r]
while {[gets $f line] >= 0} {
    foreach {ip date name browser} [split $line "\t"] {break}
    append filemap([string trim $name]) .
}
close $f

foreach {name str} [array get filemap] {
    lappend files [list [string length $str] $name]
}
unset filemap

foreach line [lsort -integer -index 0 $files] {
    foreach {count file} $line {}
    puts [format "%6d  %s" $count $file]
}

exit 0

Added stats.byip.tcl.














































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
#! /bin/sh
# \
exec tclsh8.0 $0 ${1+"[email protected]"}

#awk '{print $1}' ../TIP/log | sort | uniq -c | sort -n

set SRCDIR [file join [pwd] [file dirname [info script]]]
source $SRCDIR/config.tcl

set ips {}
array set ipmap {}
set threshold 0
if {[llength $argv]} {
    set threshold [lindex $argv 0]
}

set f [open $LOGFILE r]
while {[gets $f line] >= 0} {
    foreach {ip date name browser} [split $line "\t"] {break}
    append ipmap([string trim $ip]) .
}
close $f

foreach {ip str} [array get ipmap] {
    lappend ips [list [string length $str] $ip]
}
unset ipmap

foreach line [lsort -integer -index 0 $ips] {
    foreach {count host} $line {}
    if {$count > $threshold} {
	catch {
	    set host [lindex [lindex [split [exec host $host] "\n"] 0] 1]
	}
    }
    puts [format "%6d  %s" $count $host]
}

exit 0

Added tip.tcl.




























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
#! /usr/local/bin/tclsh8.0

set ThisFilename [file join [pwd] [info script]]
while {![string compare [file type $ThisFilename] link]} {
    # This is a symlink!
    set ThisFilename [file join [file dirname $ThisFilename] \
	    [file readlink $ThisFilename]]
}
set SRCDIR [file dirname $ThisFilename]
source $SRCDIR/config.tcl

# This is *not* configurable because changing it can require many other
# changes to be made throughout the rest of the TIP suite.  It is also
# not used outside this file.
set DOCTYPE "<!DOCTYPE HTML PUBLIC\
	\"-//W3C//DTD HTML 4.01 Transitional//EN\"\
	\"http://www.w3.org/TR/REC-html401/loose.dtd\">"
set DOCTYPE_FRAMES "<!DOCTYPE HTML PUBLIC\
	\"-//W3C//DTD HTML 4.01 Frameset//EN\"\
	\"http://www.w3.org/TR/REC-html401/frameset.dtd\">"

# Get the time when a file was last modified, in the format used by
# webservers (apparently.)
proc lastModTime {filename} {
    # Removed day-of-week spec (which is written in by the
    # webserver instead) but am not using %T since that is
    # not universally supported - DKF
    return [clock format [file mtime $filename] \
	    -format "%d %B %Y %H:%M:%S GMT" -gmt 1]
}
# MH recommends a different format for Expires headers - DGP
proc expireTime {filename} {
    # %T -> %H:%M:%S (see above) DKF
    return [clock format [file mtime $filename] \
	    -format "%a, %d %b %Y %H:%M:%S GMT" -gmt 1]
}

proc gendoc {filename kind} {
    global contenttypes

    # Head off the most common kind of "probing" error
    if {![file readable $filename]} {
	return -code error "File unreadable or non-existant"
    }

    set f [open $filename r]
    set d [read $f [file size $filename]]
    close $f

    if {![string compare $kind .htm]} {
	set kind .html
    }
    set data [formatTIPDocument $d [string trim $kind .]]
    array set info [getTIPDetails $filename]

    puts "Content-Type: $contenttypes($kind)"
    if {[info exist info(Keywords)]} {
	puts "Keywords: [file join $info(Keywords) {, }]"
    }
    # Assume we can get away with this...
    puts "Content-Length: [string length $data]"
    # Active TIPs must always be regenerated from source, so we cannot
    # supply a date of last modification.  This is because they might
    # format differently despite the source remaining unchanged.
    if {[string compare $info(State) Active]} {
	puts "Last-Modified: [lastModTime $filename]"
	puts "Expires: [expireTime $filename]"
	puts "Cache-Control: no-cache, must-revalidate"
	puts "Pragma: no-cache"
    }
    puts ""
    puts -nonewline $data
}

proc transferraw {filename kind} {
    global contenttypes

    # Head off the most common kind of "probing" error
    if {![file readable $filename]} {
	return -code error "File unreadable or non-existant"
    }

    set f [open $filename r]
    fconfigure $f -translation binary
    puts "Content-Type: $contenttypes($kind)"
    puts "Content-Length: [file size $filename]"
    puts "Last-Modified: [lastModTime $filename]"
    puts ""
    fconfigure stdout -translation binary
    fcopy $f stdout
    flush stdout
    fconfigure stdout -translation auto
    close $f
}

proc generr {title body {pfmt {}} {rcode 404} {errcode NONE}} {
    global env BASETARG BASEURL CSSURL ICONURL URI DOCTYPE

    set title "ERROR: $title"

    fconfigure stdout -translation auto

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts "Response-Code: $rcode"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>$title</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"$BASETARG\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"\
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    puts "<h1>$title</h1><hr>"
    puts "<p align=\"justify\">An error occurred when serving $URI to you\
	    because $body.</p>"
    if {[info exist env(HTTP_REFERER)]} {
	puts "<p align=\"justify\">You might wish to inform the author of the\
		<a href=\"$env(HTTP_REFERER)\">referring page</a>.</p>"
    }
    if {[string length $pfmt]} {
	puts "<h2>Debugging Info:</h2><blockquote><pre>"
	regsub -all & $pfmt {\&amp;} pfmt
	regsub -all < $pfmt {\&lt;}  pfmt
	regsub -all > $pfmt {\&gt;}  pfmt
	puts "$pfmt"
	puts -nonewline "</pre></blockquote>"
	if {[string compare $errcode NONE]} {
	    regsub -all & $errcode {\&amp;} errcode
	    regsub -all < $errcode {\&lt;}  errcode
	    regsub -all > $errcode {\&gt;}  errcode
	    puts "<h2>Error Code Trace:</h2><p>$errcode</p>"
	}
    }
    basicHTMLfooter
    exit
}


proc serveFile {filename} {
    global renderable DOCDIR errorInfo contenttypes
    set ext [file extension $filename]
    set filename [file join $DOCDIR [file tail $filename]]
    if {![info exist contenttypes($ext)]} {
	generr "Data unservable" \
		"that view of the document is not known and/or supported"
    }
    # At this point, if the working directory $DOCDIR hasn't been
    # configured to get automatic updates on each commit, then a
    # 'cvs update' on $filename should be done here.  A 'cvs update'
    # with every web hit would be very inefficient, so set up the
    # automatic updates as indicated in config.tcl.
    #
    # If you're operating read-only, you can get away with using cron
    # to run 'cvs update' instead and take whatever lag you are
    # prepared to tolerate as a given...
    if {[lsearch -exact $renderable $ext] >= 0} {
	set filename [file rootname $filename].tip
	gendoc $filename $ext
    } else {
	transferraw $filename $ext
    }
    exit
}

proc processCGIOptions {{env env}} { # easier to test!
    upvar #0 $env e
    global URI SRCDIR FEATURE
    global bodyURL indexType orderingColumn searchTerm searchArea
    global revision0 revision1 revision2 cookie
    global searchLocus searchAuthor searchDate searchDateRelation searchSort
    global mailName mailUser mailSys mailTipNum

    set URI http://$e(SERVER_NAME)
    if {$e(SERVER_PORT) != 80} {
	append URI : $e(SERVER_PORT)
    }
    append URI $e(REQUEST_URI)

    if {[info exist e(HTTP_COOKIE)]} {
	foreach keyval [split $e(HTTP_COOKIE) ";"] {
	    regexp { *([^=]+)=(.*)} $keyval -> key val
	    set cookie($key) $val
	}
    }

    switch -- $e(REQUEST_METHOD) {
	GET - HEAD {
	    # these are OK
	}
	POST {
	    if {!$FEATURE(EDIT) && [info exist e(QUERY_STRING)]} {
		switch -glob -- $e(QUERY_STRING) {
		    /edit/* {
			generr "Unknown Request" "the request\
				$e(REQUEST_METHOD) for URL $URI is not\
				supported for that resource" {} 403
		    }
		}
	    }
	    source $SRCDIR/post.tcl
	    post::getVars $env
	}
	default {
	    generr "Unknown Request" "the request $e(REQUEST_METHOD)\
		    for URL $URI is not supported for that resource" {} 403
	}
    }

    array set query {
	body    1.html
	type    *
	sort    none
	search  ""
	where   ""
	cmpa    1.1
	cmpb    1.1
	ver     NONE
	locus   ""
	daterel ""
	author  ""
	sortby  TIP
	day     ""
	month   ""
	year    ""
	name    ""
	user    foobar
	sys     some.where
	tipnum  10000
    }
    array set multiple {
	locus 1
    }
    if {[info exist e(QUERY_STRING)]&&[string length $e(QUERY_STRING)]} {
	foreach qs [split $e(QUERY_STRING) ,&] {
	    if {
		![regexp {^(.*)=(.*)$} $qs -> key value] ||
		![info exist query($key)]
	    } then {
		generr "Unknown URI" \
			"the uri $URI is not found on this server"
	    }
	    # Decode arguments
	    regsub -all {\+} $value " " value
	    regsub -all {[]${}\\[]} $value {\\&} value
	    regsub -all {%([0-9A-Fa-f][0-9A-Fa-f])} $value \
		    {[format %c 0x\1]} value
	    if {[info exist multiple($key)]} {
		lappend query($key) [subst $value]
	    } else {
		set query($key) [subst $value]
	    }
	}
    }

    set bodyURL 1.html
    set indexType *
    set orderingColumn -1
    set searchTerm ""
    set searchArea 0
    set revision0 NONE
    set revision1 1.1
    set revision2 1.1

    if {
	![info exist e(PATH_INFO)] ||
	![string length $e(PATH_INFO)] ||
	[string match / $e(PATH_INFO)]
    } then {
	set bodyURL $query(body)
	return /index.html
    }

    set indexType $query(type)
    set orderingColumn $query(sort)
    set searchTerm $query(search)
    set searchArea [string match Also* $query(where)]
    set searchLocus [lsort $query(locus)]
    set searchAuthor $query(author)
    set searchSort $query(sortby)
    if {[lsearch -exact $query(locus) created]} {
	set searchDate $query(day)-$query(month)-$query(year)
	set searchDateRelation $query(daterel)
    } else {
	set searchDate ""
	set searchDateRelation ""
    }
    set revision0 $query(ver)
    set revision1 $query(cmpa)
    set revision2 $query(cmpb)
    set mailName $query(name)
    set mailUser $query(user)
    set mailSys $query(sys)
    set mailTipNum $query(tipnum)
    set path $e(PATH_INFO)
    if {![string length [file extension $path]]} {
	append path .html
    }

    return $path
}

proc basicHTMLfooter {} {
    global TCLLOGOURL TCLLOGOX TCLLOGOY FOOTERTEXT
    puts "<hr><img alt=\"Powered by Tcl\" src=\"$TCLLOGOURL\"\
	    width=\"$TCLLOGOX\" height=\"$TCLLOGOY\"\
	    align=\"right\"><address>$FOOTERTEXT</address></body></html>"
}

proc serveFrameset {body} {
    global BASEURL DOCTYPE_FRAMES ICONURL
    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE_FRAMES
    puts "<html><head><title>TIP Document Collection</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "<base href=\"$BASEURL\">"
    puts "</head><frameset cols=\"150,*\">"
    puts "<frame src=\"short.html#last\"><frame src=\"$body\" name=\"body\">"
    puts "<noframes><p align=\"justify\">Oh dear!  Your browser don't seem\
	    to support frames; perhaps you might wish to visit the\
	    <a href=\"1.html\">TIP index</a> by way of consolation?\
	    </p></noframes>"
    puts "</frameset></html>"
    exit
}

proc serveIndex {kind type} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL DOCTYPE
    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>TIP Index</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    source $SRCDIR/tiphtml.tcl
    tiphtml::index $kind hardError $type
    puts "<hr>"
    puts "<p><font size=\"1\">The TIP archive is available by anonymous\
	    CVS, and this <a href=\"$ENGINEURL\">TIP Rendering\
	    engine</a> is available online too.</font></p>"
    puts "<div align=\"right\"><p><a\
	    href=\"http://validator.w3.org/check/referer\"><img border=\"0\"\
	    src=\"valid-html40.gif\" alt=\"Valid HTML 4.0!\" height=\"31\"\
	    width=\"88\"></a></p></div></body></html>"
    exit
}

proc serveTclIndex {} {
    puts "Content-Type: text/plain"
    puts ""
    set outerlist {}
    foreachTIP h {
	set l {}
	foreach field {
	    TIP Type State Vote Title Created Author Version
	    Tcl-Version Keywords Obsoletes Obsoleted-By
	    Vote-By Voted-For Voted-Against Voted-Abstained
	    Abstract
	} {
	    if {[info exist h($field)]} {
		lappend l $field $h($field)
	    }
	}
	lappend outerlist $l
    }
    puts $outerlist
    exit
}

proc serveSearch {searchTerm lookInBodies} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL DOCTYPE
    source $SRCDIR/tiphtml.tcl

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>Searching for\
	    [tiphtml::quoteLiteral $searchTerm]</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    if {[string length $searchTerm]} {
	tiphtml::longidx * $searchTerm $lookInBodies
	puts -nonewline "<hr>"
    }
    puts "<form method=\"GET\" action=\"search.html\"><p\
	    >Search&nbsp;for:&nbsp;<input size=\"40\" name=\"search\"\
	    value=\"$searchTerm\"><br><input type=\"submit\" name=\"where\"\
	    value=\"Search titles, keywords and abstracts\">&nbsp;<a\
	    href=\"advancedsearch.html\">Advanced Search</a></p></form>"
    basicHTMLfooter
    exit
}

proc optMenu {var default args} {
    set s "<select name=\"$var\"><option selected>$default</option>"
    foreach arg $args {append s "<option>$arg</option>"}
    append s "</select>"
}
proc advancedSearch {} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL DOCTYPE
    source $SRCDIR/tiphtml.tcl

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>Advanced Search</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    puts "<h1>Advanced Search of TIP Archive</h1><hr><form method=\"GET\"\
	    action=\"advancedsearchresults.html\"><p><strong\
	    >Criteria:</strong><br> Search for <input name=\"search\"> in\
	    <input type=\"checkbox\" name=\"locus\" value=\"titles\"\
	    checked> Titles <input type=\"checkbox\" name=\"locus\"\
	    value=\"keywords\" checked> Keywords <input type=\"checkbox\"\
	    name=\"locus\" value=\"abstracts\" checked> Abstracts <input\
	    type=\"checkbox\" name=\"locus\" value=\"bodies\"> Bodies<br>"
    puts "<input type=\"checkbox\" name=\"locus\" value=\"authors\"> <strong\
	    >and</strong> by an author whose name or email address includes\
	    the string: <input name=\"author\"><br>"
    puts "<input type=\"checkbox\" name=\"locus\" value=\"created\"> <strong\
	    >and</strong> created [optMenu daterel on before after] the date\
	    [optMenu day 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17\
	    18 19 20 21 22 23 24 25 26 27 28 29 30 31]-[optMenu month Jan Feb\
	    Mar Apr May Jun Jul Aug Sep Oct Nov Dec]-[optMenu year 2000 2001\
	    2002 2003 2004 2005]</p>"
    puts "<p><strong>Options:</strong><br>\
	    [srchCB locus nofinal  {Ignore Final TIPs}]\
	    [srchCB locus nodraft  {Ignore Draft TIPs}]\
	    [srchCB locus project  {Ignore Non-Project TIPs}]\
	    [srchCB locus noreject {Ignore Rejected and Withdrawn TIPs}]</p>"
    puts "<p><strong>Sort result:</strong><br><input type=\"radio\"\
	    name=\"sortby\" value=\"TIP\" checked> Series ID <input\
	    type=\"radio\" name=\"sortby\" value=\"Title\"> Title <input\
	    type=\"radio\" name=\"sortby\" value=\"State\"> State <input\
	    type=\"radio\" name=\"sortby\" value=\"Type\"> Type <input\
	    type=\"radio\" name=\"sortby\" value=\"Vote\"> Voting Status<p\
	    ><input type=\"submit\" value=\"Search Archive\"></form>"
    basicHTMLfooter
    exit
}
proc srchCB {name value label} {
    regsub -all " " $label {\&nbsp;} label
    format "<input type=\"checkbox\" name=\"%s\" value=\"%s\">&nbsp;%s" \
	    $name $value $label
}
proc serveSearch2 {locus pat1 pat2 date daterel order} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL DOCTYPE
    source $SRCDIR/tiphtml.tcl

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>Results of Advanced Search</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    tiphtml::longidx2 $locus $pat1 $pat2 $date $daterel $order
    puts -nonewline "<hr>"
    puts "<form method=\"GET\" action=\"search.html\"><p\
	    >Search&nbsp;for:&nbsp;<input size=\"40\" name=\"search\"\
	    value=\"$pat1\"><br><input type=\"submit\" name=\"where\"\
	    value=\"Search titles, keywords and abstracts\"></p></form>"
    basicHTMLfooter
    exit
}

proc serveHistory {tipnumber} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL EDITDIR DOCDIR DOCTYPE
    set EDITDIR $DOCDIR
    source $SRCDIR/history.tcl

    if {![regexp {^[0-9]+$} $tipnumber]} {
	generr "Unknown TIP number" "TIPs must be numbered"
    }
    set leh [history::fmtlogentries $tipnumber]

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>CVS History for TIP #$tipnumber</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    puts "<h1>CVS History for TIP #$tipnumber</h1>"

    puts "<div align=\"center\">$leh</div>"

    basicHTMLfooter
    exit
}

proc serveDiff {tipnumber revision1 revision2} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL EDITDIR DOCDIR DOCTYPE
    set EDITDIR $DOCDIR
    source $SRCDIR/history.tcl

    if {![regexp {^[0-9]+$} $tipnumber]} {
	generr "Unknown TIP number" "TIPs must be numbered"
    }
    set dlh [history::fmtdifflines $tipnumber $revision1 $revision2]

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>Comparing version $revision1 and $revision2\
	    for TIP #$tipnumber</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    puts "<h1>Comparing version $revision1 and $revision2 for\
	    TIP #$tipnumber</h1>"
    variable history::addbg
    variable history::delbg
    puts "<p>Note that these changes are shown as applied to the source\
	    document, and not as applied to the rendering into any\
	    particular display format. <span style=\"background-color:\
	    $addbg\">Added lines are highlighted like this,</span> and\
	    <span style=\"background-color: $delbg\">deleted lines are\
	    highlighted like this.</span></p><hr>"

    puts $dlh

    basicHTMLfooter
    exit
}

proc serveRevision {tipnumber version} {
    global EDITDIR DOCDIR SRCDIR
    set EDITDIR $DOCDIR
    source $SRCDIR/history.tcl

    if {![regexp {^[0-9]+$} $tipnumber]} {
	generr "Unknown TIP number" "TIPs must be numbered"
    }
    if {![regexp {^[0-9]+(\.[0-9]+)+$} $version]} {
	generr "Unknown revision" "this server will not retrieve TIPs by tags"
    }
    set content [history::fmtrevision $tipnumber $version]
    puts "Content-Type: text/html; charset=iso-8859-1"
    puts "Content-Length: [string length $content]"
    puts ""
    puts $content
    exit
}

proc logAccess {what} {
    global env LOGFILE
    set RA ?.?.?.?
    set UA ?
    catch {set RA $env(REMOTE_ADDR)}
    catch {set UA $env(HTTP_USER_AGENT)}
    if {[catch {set f [open $LOGFILE a]}]} {return}
    puts $f [format "%-15s\t%-10d\t%-15s\t%s" $RA [clock seconds] $what $UA]
    flush $f
    close $f
}

catch {
    if {[catch {
	source $SRCDIR/parse.tcl

	set what [processCGIOptions]
	logAccess $what
	if {[info exist cookie(chongqid)]} {
	    generr "Temporary access problem" \
		    "Temporary access problem detected; do try later." 402
	}
	switch -glob -- $what {
	    / - /index.html {
		set cmd [list serveFrameset $bodyURL]
	    }
	    /tclIndex.txt {
		set cmd serveTclIndex
	    }
	    /short.html - /medium.html - /long.html {
		set cmd [list serveIndex \
			[file rootname [file tail $what]] $indexType  ]
	    }
	    /search.html {
		set cmd [list serveSearch $searchTerm $searchArea]
	    }
	    /advancedsearch.html {
		set cmd [list advancedSearch]
	    }
	    /advancedsearchresults.html {
		set cmd [list serveSearch2 $searchLocus $searchTerm \
			$searchAuthor $searchDate $searchDateRelation \
			$searchSort]
	    }
	    /edit/* {
		if {!$FEATURE(EDIT)} {
		    generr "Feature Not Supported" \
			    "editing is not supported on this server"
		}
		source $SRCDIR/edit.tcl
		set cmd [list \
			editTIP [file rootname [string range $what 6 end]]  ]
	    }
	    /compare/* {
		if {0&!$FEATURE(CVSWEB)} {
		    generr "Feature Not Supported" "CVS history inspection\
			    is not supported on this server"
		}
		set cmd [list serveDiff \
			[file rootname [string range $what 9 end]] \
			$revision1 $revision2]
	    }
	    /history/* {
		if {0&!$FEATURE(CVSWEB)} {
		    generr "Feature Not Supported" "CVS history inspection\
			    is not supported on this server"
		}
		set cmd [list serveHistory \
			[file rootname [string range $what 9 end]]]
	    }
	    /view/* {
		if {0&!$FEATURE(CVSWEB)} {
		    generr "Feature Not Supported" "CVS history inspection\
			    is not supported on this server"
		}
		set cmd [list serveRevision \
			[file rootname [string range $what 6 end]] \
			$revision0]
	    }
	    /mail.html {
		source $SRCDIR/mail.tcl
		set cmd [list mail::mailform $mailName $mailUser $mailSys \
			$mailTipNum]
	    }
	    /sendmail.html {
		source $SRCDIR/mail.tcl
		set cmd [list mail::mailformaccept]
	    }
	    default {
		set cmd [list serveFile $what]
	    }
	}
    } error]} {
	generr "Internal Error" "unexpected condition \"$error\" occurred" \
		$errorInfo 500 $errorCode
    }
    if {[catch $cmd error]} {
	generr "Internal Error" "unexpected condition \"$error\" occurred" \
		$errorInfo 500 $errorCode
    }
}
exit 0

Added tiparchive.tcl.




































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#! /usr/local/bin/tclsh8.0

set SRCDIR [file join [pwd] [file dirname [info script]]]
set convert {}
set pwd [pwd]
catch {
    source $SRCDIR/config.tcl
    source $SRCDIR/parse.tcl
    source $SRCDIR/tiptex.tcl

    proc tiptex::puts {args} {
	global convert
	switch [llength $args] {
	    2 {append convert [lindex $args 1]}
	    1 {append convert [lindex $args 0] "\n"}
	}
    }
    tiptex::generateWholeArchive
    switch -- [lindex $argv 1] {
	ps {
	    linkEPSImagesForDocument all $pwd
	}
	pdf {
	    makePDFImagesForDocument all $pwd
	}
    }

    set f [open [file join $pwd [lindex $argv 0]] w]
    puts -nonewline $f $convert
    close $f
    exit
}
puts $errorInfo
exit 1

Added tiphtml.tcl.








































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
namespace eval tiphtml {
    variable curlev -1
    variable contexts {}
    variable nextrefcounter 0

    proc codechar {c} {
	scan $c %c char
	format %%%02x [expr {$char & 0xff}]
    }
    proc formcode {key args} {
	regsub -all {[^a-zA-Z0-9]} [join $args] {[codechar \\&]} str
	return $key=[subst $str]
    }
    proc nextrefnum {} {
	variable nextrefcounter
	incr nextrefcounter
    }
    proc xformdots {str} {
	regsub -all {[.]} $str " <span class=\"midmail\">dot</span> " str
	return $str
    }
    proc xformmailto {str {tip {}}} {
	global BASEURL
	set url ${BASEURL}mail.html?
	regsub -all {[];${}\\[]} $str {\\&} str
	# Make nameless subst
	regsub -all "href=\"mailto:(\[^@]+)@(\[^\",]+)\"" $str \
		"href=\"$url\[formcode user \\1],\[formcode sys\
		\\2],tipnum=$tip\"" str
	# Make named subst
	regsub -all "href=\"mailto:(\[^@]+)@(\[^\",]+),(\[^\"]+)\"" $str \
		"href=\"$url\[formcode user \\1],\[\
		formcode sys \\2],\[formcode name \\3],tipnum=$tip\"" str
	# Perform substitutions
	subst $str
    }
    proc xformauthor {name email tip {longFmt 0}} {
	set name [string trim $name]
	foreach {user sys} [split $email @] {break}
	set user [xformdots $user]
	set sys [xformdots $sys]
	if {$longFmt} {
	    if {[string length $name]} {
		set link "$name &lt;<a title=\"Click to contact $name by\
			email\" onmouseover=\"window.status='Click to\
			contact $name by email';return true\"\
			href=\"mailto:$email,$name\">${user} <span\
			class=\"midmail\">at</span> ${sys}</a>&gt;"
	    } else {
		set link "<a title=\"Click to contact this author by\
			email\" onmouseover=\"window.status='Click to\
			contact this author by email';return true\"\
			href=\"mailto:$email\">${user} <span\
			class=\"midmail\">at</span> ${sys}</a>"
	    }
	} elseif {[string length $name]} {
	    set link "<a title=\"Click to contact $name by email\"\
		    onmouseover=\"window.status='Click to contact\
		    $name by email';return true\"\
		    href=\"mailto:$email,$name\">$name</a>"
	} else {
	    set link "<a title=\"Click to contact this author by\
		    email\" onmouseover=\"window.status='Click to\
		    contact this author by email';return true\"\
		    href=\"mailto:$email\">$user <span\
		    class=\"midmail\">at</span> $sys</a>"
	}
	return [xformmailto $link $tip]
    }

    proc enterlistcontext {level good bad1 bad2} {
	variable curlev
	variable contexts
	if {$level > $curlev} {
	    incr curlev
	    lappend contexts "</$good>"
	    puts -nonewline "<$good compact>"
	}
	switch [lindex $contexts end] "</$bad1>" - "</$bad2>" {
	    puts -nonewline [lindex $contexts end]
	    puts -nonewline "<$good compact>"
	    set contexts [lreplace $contexts end end "</$good>"]
	}
    }
    proc closecontext {{level -1}} {
	variable curlev
	variable contexts
	while {$level < $curlev} {
	    incr curlev -1
	    puts -nonewline [lindex $contexts end]
	    set contexts [lrange $contexts 0 [expr {[llength $contexts]-2}]]
	}
    }
    proc quoteLiteral {string} {
	# In 8.3 or later, we'd use [string map] for this.  But this
	# code has to work with 8.0 so we're stuck with [regsub -all]
	regsub -all &  $string {\&amp;}  string
	regsub -all <  $string {\&lt;}   string
	regsub -all >  $string {\&gt;}   string
	regsub -all \" $string {\&quot;} string
	regsub -all \xa0 $string {\&nbsp;} string
	return $string
    }

    proc section {title {level 1}} {
	closecontext
	incr level
	puts "<h$level>[quoteLiteral $title]</h$level>"
    }
    proc ordinary {string} {
	continuation -1 $string
    }
    proc bulleting {level body} {
	closecontext $level
	enterlistcontext $level ul ol dl
	puts -nonewline "<li>"
	continuation $level $body
    }
    proc description {tag level body} {
	closecontext $level
	enterlistcontext $level dl ol ul
	puts -nonewline "<dt>$tag</dt><dd>"
	continuation $level $body
    }
    proc enumeration {tag level body} {
	closecontext $level
	enterlistcontext $level ol dl ul
	if {$tag != 1} {
	    puts -nonewline "<li value=\"$tag\">"
	} else {
	    puts -nonewline "<li>"
	}
	continuation $level $body
    }
    proc continuation {level body} {
	global EmailRE URLRE TIPURLRE ShortTIPRE BASEURL ISSUEBASE ISSUEURLRE
	variable thisTIPnumber

	closecontext $level
	regsub -all $EmailRE $body "\x81mailto:\\1\x82" body
	regsub -all $TIPURLRE $body "$BASEURL\\1.html" body
	regsub -all $ISSUEURLRE $body "$ISSUEBASE\\1" body
	set body [quoteLiteral $body]

	#regsub -all {[][\\ $;]} $body {\\&} body
	#regsub -all $URLRE $body "<a href=\"&\">\[addwbr &\]</a>" body
	#set body [subst -novar $body]
	regsub -all {\[\[} $body \x83 body
	regsub -all {\]\]} $body \x84 body
	regsub -all \\\[($URLRE)\\\] $body "\x83<a href=\"\\2\x86\\4\">\x85</a>\x84" body
	regsub -all $URLRE $body "<a href=\"&\">&</a>" body

	regsub -all {'''(('?[^'])+)'''} $body "<b>\x87\\1</b>" body
	regsub -all {''(('?[^'\x87])+)''} $body "<i>\\1</i>" body
	regsub -all $ShortTIPRE $body "<a href=\"\\1.html\">TIP #\\1</a>" body
	regsub -all {\[} $body \x83 body
	regsub -all {\]} $body \x84 body
	#mail address monkeying...
	if {[info exist thisTIPnumber]} {
	    set body [xformmailto $body $thisTIPnumber]
	} else {
	    set body [xformmailto $body]
	}
	regsub -all {>mailto:([^][{};\\$<>@]+)@([^][{};\\$<>@]+)<} $body \
		">\[xformdots \\1\] <span\
		class=\"midmail\">at</span> \[xformdots \\2\]<" body
	regsub -all \x85 $body {[nextrefnum]} body
	regsub -all \x81 [subst -novar -noback $body] "\\&lt;" body
	regsub -all \x82 $body "\\&gt;" body
	regsub -all \x83 $body \[ body
	regsub -all \x84 $body \] body
	regsub -all \x86 $body : body
	regsub -all \x87 $body {} body
	variable curlev
	if {$curlev==-1 && $level==1} {
	    puts "<blockquote><p align=\"justify\">$body</p></blockquote>"
	} else {
	    puts "<p align=\"justify\">$body</p>"
	}
    }
    proc separator {} {
	closecontext
	puts "<hr>"
    }
    proc verbatim {lines} {
	puts "<pre>"
	foreach line $lines {
	    # HTML ignores formfeed chars, but we want to see them...
	    regsub -all { } [quoteLiteral $line] "<b><u>^L</u></b>" line
	    puts $line
	}
	puts -nonewline "</pre>"
    }

    # Helpers to generate 'long' style indices
    proc tr {c1 c2 {size 1}} {
	puts -nonewline "<tr><td align=\"right\" valign=\"top\"><font\
		size=\"$size\">$c1"
	puts "</font></td><td><font size=\"$size\">$c2</font></td></tr>"
    }
    proc longidx {tpat {srch ""} {searchbody 0}} {
	set matched 0
	if {[string match 8.0* [info tclversion]] && [string length $srch]} {
	    regsub -all {[^a-zA-Z0-9]} $srch {\\&} RE
	} else {
	    set RE ***=$srch
	}
	foreachTIP d {
	    # must match type pattern and 
	    if {
		![string match $tpat [string tolower $d(Type)]] ||
		([string length $srch] &&
		 ![regexp $RE "TIP #$d(TIP): $d(Title)"] &&
		 (![info exist d(Keywords)] ||
		  [lsearch -regexp $d(Keywords) $RE] < 0) &&
		 ![regexp $RE $d(Abstract)] &&
		 (!$searchbody || [lsearch -regexp $d(Body) $RE] < 0))
	    } then {
		continue
	    }
	    set matched 1
	    puts "<p><table width=\"99%\"><tr><td valign=\"top\">"

	    puts -nonewline "<a href=\"$d(TIP).html\">"
	    puts "<strong><font size=\"4\">TIP #$d(TIP):\
		    $d(Title)</font></strong>"
	    puts "</a><dl><dt><tt>$d(Version)</tt></dt><dd>"
	    ordinary $d(Abstract)
	    puts "</dd></dl>"

	    puts "</td><td valign=\"top\"><table border><tr><td><table>"
	    set at "Author:"
	    global AuthorRE
	    foreach a $d(Author) {
		regexp "^$AuthorRE" $a -> name mail
		tr $at [xformauthor $name $mail $d(TIP)]
		#tr $at "<a href=\"mailto:$mail\">$name</a>"
		set at ""
	    }
	    tr Type: $d(Type)
	    if {[info exist d(Tcl-Version)]} {
		tr "Tcl Version:" $d(Tcl-Version)
	    }
	    tr State: $d(State)
	    tr Vote: $d(Vote)
	    tr Created: [clock format $d(Created) -format "%d %b %Y" -gmt 1]
	    tr "Posting History:" [join [split $d(Post-History) ","] "<br>"]
	    if {[info exist d(Discussions-To)]} {
		set dtlink {}
		foreach dt [split $d(Discussions-To) ,] {
		    regsub "^(mailto|news):" $dt "" dtnproto
		    lappend dtlink "<a href=\"$dt\">$dtnproto</a>"
		}
		tr "Discussions To:" [join $dtlink "<br>"]
	    }
	    if {[info exist d(Obsoletes)]} {
		tr Obsoletes: "<a title=\"Visit the obsoleted TIP\"\
			href=\"$d(Obsoletes).html\">TIP #$d(Obsoletes)</a>"
	    }
	    if {[info exist d(Obsoleted-By)]} {
		tr "Obsoleted By:" "<a title=\"Visit the obsoleting TIP\"\
			href=\"$d(Obsoleted-By).html\"\
			>TIP #$d(Obsoleted-By)</a>"
	    }
	    if {[info exist d(Vote-By)]} {
		if {$d(Vote-By) > [clock seconds]} {
		    tr Vote: [clock format $d(Vote-By) -gmt 1 \
			    -format "%d %b %Y, %H:%M GMT"]
		} else {
		    tr Vote-By: [clock format $d(Vote-By) -gmt 1 \
			    -format "%d %b %Y, %H:%M GMT (closed)"]
		}
	    }
	    if {[info exist d(Votes-For)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Votes-Against)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Votes-Abstained)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Keywords)]} {
		set kws {}
		set kwl 0
		set comma ""
		foreach k $d(Keywords) {
		    append kws $comma $k
		    incr kwl [string length $k]
		    if {$kwl > 12} {
			set kwl 0
			set comma ",<br>"
		    } else {
			set comma ", "
		    }
		}
		tr Keywords: $kws
	    }
	    puts "</table></td></tr></table></td></tr></table>"
	}
	if {!$matched} {
	    puts "<p align=\"justify\">No existing TIPs matched your\
		    search criteria.</p>"
	}
    }
    proc stest {flagname state} {
	upvar 1 flag flagAry d headers
	expr {$flagAry($flagname) && ![string compare $headers(State) $state]}
    }
    proc longidx2 {locus pat1 pat2 dateLimit daterel order} {
	array set flag {
	    titles 0
	    keywords 0
	    abstracts 0
	    bodies 0
	    authors 0
	    created 0
	    nofinal 0
	    nodraft 0
	    project 0
	    noreject 0
	}
	foreach feature $locus {set flag($feature) 1}
	set matched {}
	if {[string match 8.0* [info tclversion]]} {
	    regsub -all {[^a-zA-Z0-9]} $pat1 {\\&} RE1
	    regsub -all {[^a-zA-Z0-9]} $pat2 {\\&} RE2
	} else {
	    set RE1 ***=$pat1
	    set RE2 ***=$pat2
	}
	if {$flag(created)} {
	    regsub -- (.+)-(.+)-(.+) $dateLimit {\2 \1, \3} dateLimit
	    set dateLimit [clock scan $dateLimit -gmt 1]
	}
	foreachTIP d {
	    # skip some TIPs if requested
	    if {
		[stest nofinal  Final]    || [stest nodraft  Draft]     ||
		[stest noreject Rejected] || [stest noreject Withdrawn] ||
		($flag(project) && [string compare $d(Type) Project])
	    } then {
		continue
	    }
	    # Perform main search
	    if {
		[string length $pat1] &&
		(!$flag(titles) || ![regexp $RE1 "TIP #$d(TIP): $d(Title)"]) &&
		(!$flag(keywords) || [info exist d(Keywords)] && [lsearch -regexp $d(Keywords) $RE1]<0) &&
		(!$flag(abstracts) || ![regexp $RE1 $d(Abstract)]) &&
		(!$flag(bodies) || [lsearch -regexp $d(Body) $RE1]<0)
	    } then {
		continue
	    }
	    # Perform author filtering
	    if {$flag(authors) && [lsearch -regexp $d(Author) $RE2]<0} {
		continue
	    }
	    # Perform date filtering
	    if {$flag(created)} {
		switch -- $daterel {
		    on {
			if {$d(Created) != $dateLimit} {continue}
		    }
		    before {
			if {$d(Created) >= $dateLimit} {continue}
		    }
		    after {
			if {$d(Created) <= $dateLimit} {continue}
		    }
		    default {
			continue
		    }
		}
	    }
	    lappend matched [list $d($order) [array get d]]
	}
	if {[array exists d]} {
	    unset d
	}
	foreach match [lsort -dictionary -index 0 $matched] {
	    array set d [lindex $match 1]
	    puts "<p><table width=\"99%\"><tr><td valign=\"top\">"

	    puts -nonewline "<a href=\"$d(TIP).html\">"
	    puts "<strong><font size=\"4\">TIP #$d(TIP):\
		    $d(Title)</font></strong>"
	    puts "</a><dl><dt><tt>$d(Version)</tt></dt><dd>"
	    ordinary $d(Abstract)
	    puts "</dd></dl>"

	    puts "</td><td valign=\"top\"><table border><tr><td><table>"
	    set at "Author:"
	    global AuthorRE
	    foreach a $d(Author) {
		regexp "^$AuthorRE" $a -> name mail
		tr $at [xformauthor $name $mail $d(TIP)]
		#tr $at "<a href=\"mailto:$mail\">$name</a>"
		set at ""
	    }
	    tr Type: $d(Type)
	    if {[info exist d(Tcl-Version)]} {
		tr "Tcl Version:" $d(Tcl-Version)
	    }
	    tr State: $d(State)
	    tr Vote: $d(Vote)
	    tr Created: [clock format $d(Created) -format "%d %b %Y" -gmt 1]
	    tr "Posting History:" [join [split $d(Post-History) ","] "<br>"]
	    if {[info exist d(Discussions-To)]} {
		set dtlink {}
		foreach dt [split $d(Discussions-To) ,] {
		    regsub "^(mailto|news):" $dt "" dtnproto
		    lappend dtlink "<a href=\"$dt\">$dtnproto</a>"
		}
		tr "Discussions To:" [join $dtlink "<br>"]
	    }
	    if {[info exist d(Obsoletes)]} {
		tr Obsoletes: "<a href=\"$d(Obsoletes).html\"\
			>TIP #$d(Obsoletes)</a>"
	    }
	    if {[info exist d(Obsoleted-By)]} {
		tr "Obsoleted By:" "<a href=\"$d(Obsoleted-By).html\"\
			>TIP #$d(Obsoleted-By)</a>"
	    }
	    if {[info exist d(Vote-By)]} {
		if {$d(Vote-By) > [clock seconds]} {
		    tr Vote: [clock format $d(Vote-By) -gmt 1 \
			    -format "%d %b %Y, %H:%M GMT"]
		} else {
		    tr Vote-By: [clock format $d(Vote-By) -gmt 1 \
			    -format "%d %b %Y, %H:%M GMT (closed)"]
		}
	    }
	    if {[info exist d(Votes-For)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Votes-Against)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Votes-Abstained)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Keywords)]} {
		set kws {}
		set kwl 0
		set comma ""
		foreach k $d(Keywords) {
		    append kws $comma $k
		    incr kwl [string length $k]
		    if {$kwl > 12} {
			set kwl 0
			set comma ",<br>"
		    } else {
			set comma ", "
		    }
		}
		tr Keywords: $kws
	    }
	    puts "</table></td></tr></table></td></tr></table>"
	    unset d
	}
	if {![llength $matched]} {
	    puts "<p align=\"justify\">No existing TIPs matched your\
		    search criteria.</p>"
	}
    }

    # Helpers to generate 'medium' style indices
    proc medcell {size colour style link content {hover ""}} {
	set content [quoteLiteral $content]
	if {[string length $style]} {
	    set content <$style>$content</$style>
	}
	set title ""
	if {[string length $hover]} {
	    set title "title=\"$hover\""
	}
	return "<td valign=\"baseline\"><a href=\"$link\" $title><font\
		color=\"$colour\" size=\"$size\">$content</font></a></td>"
    }
    proc medhdr {link content} {
	puts "<th><a href=\"$link\" title=\"Click to sort by $content\"\
		onmouseover=\"window.status='Click to\
		sort by $content';return true\"><font size=\"2\"\
		color=\"black\">$content</font></a></th>"
    }
    proc getStyle {type vote state} {
	upvar d d split split
	switch -glob -- $type {
	    Info*   {set ty i;set style i}
	    Project {set ty j;set style ""}
	    Process {set ty c;set style b}
	}
	set ty2 $ty
	if {$split} {set style ""}
	switch $vote {
	    "In progress" {
		set bgcol yellow
		append ty2 v
	    }
	    Pending {
		set bgcol white
		append ty2 p
	    }
	    Done - "No voting" {
		set bgcol ""
		append ty2 f
	    }
	}
	switch $state {
	    Draft {
		if {[info exist d(Obsoleted-By)]} {
		    set col #606060
		} elseif {$bgcol != "yellow"} {
		    set col #006000
		} else {
		    set col black
		}
		append ty2 .
	    }
	    Withdrawn - Rejected {
		set bgcol #c0c0c0
		if {[info exist d(Obsoleted-By)]} {
		    set col #606060
		} else {
		    set col #404040
		}
		append ty2 x
	    }
	    Accepted {
		set bgcol #CCCCFF
		if {[info exist d(Obsoleted-By)]} {
		    set col #606060
		} else {
		    set col black
		}
		append ty2 !
	    }
	    Deferred {
		set bgcol #CCFFCC
		set col black
		append ty2 d
	    }
	    Final {
		if {[info exist d(Obsoleted-By)]} {
		    set col #606060
		} else {
		    set col black
		}
		append ty2 F
	    }
	    default {
		if {[info exist d(Obsoleted-By)]} {
		    set col #606060
		} else {
		    set col black
		}
		append ty2 -
	    }
	}
	if {[info exist d(Obsoleted-By)]} {
	    append ty2 o
	}
	list $ty $col $bgcol $style $ty2
    }
    proc medidx {tpat order url} {
	set split [expr \
		{![string compare $order none] && ![string compare $tpat *]}]
	set HR "<tr><td colspan=\"4\"><hr></td></tr>"

	set url [string trimleft $url /]?type=$tpat,sort
	medhdr $url[expr {$order=="0"?"=-":"="}]0 "Series&nbsp;ID"
	medhdr $url[expr {$order=="1"?"=-":"="}]1 "Type"
	medhdr $url[expr {$order=="2"?"=-":"="}]2 "State"
	medhdr $url[expr {$order=="3"?"=-":"="}]3 "Title"
	puts -nonewline "</tr>$HR"
	array set rows {}
	if {[regexp {^-([0-3])} $order -> digit]} {
	    set rev -decreasing
	    set order $digit
	} else {
	    set rev -increasing
	}
	foreachTIP d {
	    if {![string match $tpat [string tolower $d(Type)]]} {
		continue
	    }
	    foreach {ty col bgcol style ty2} \
		    [getStyle $d(Type) $d(Vote) $d(State)] {}

	    set hover ""
	    switch -glob -- $ty2 {
		*v*  {set hover "A vote is in progress on this TIP"}
		j*d* {set hover "This TIP has been deferred"}
		j*!* {set hover "This TIP awaits implementation"}
		j*.* {set hover "This TIP is still in discussion"}
		j*F* {set hover "This TIP is in the core, version $d(Tcl-Version)"}
		*x*  {set hover "This TIP was not adopted by the TCT"}
		*o   {set hover "This TIP is obsolete"}
	    }

	    set cols {}
	    lappend cols $d(TIP) \
		    [medcell 2 $col $style $d(TIP).html TIP\ #$d(TIP) $hover]
	    if {![string compare $d(Type) Project]} {
		lappend cols $d(Type) \
			[medcell 1 $col $style $d(TIP).html \
			$d(Type)\xa0($d(Tcl-Version)) $hover]
	    } else {
		lappend cols $d(Type) \
			[medcell 1 $col $style $d(TIP).html $d(Type) $hover]
	    }
	    lappend cols $d(State) \
		    [medcell 1 $col $style $d(TIP).html $d(State) $hover]
	    lappend cols $d(Title) \
		    [medcell 2 $col $style $d(TIP).html $d(Title) $hover]
	    lappend cols $bgcol {}
	    lappend rows(all) $cols
	    lappend rows($ty) $cols
	}

	if {!$split} {
	    set index 0
	    catch {
		if {$order>=0 && $order<4} {
		    set index [expr {int($order*2)}]
		}
	    }
	    foreach row [lsort -dictionary $rev -index $index $rows(all)] {
		set bgcol [lindex $row 8]
		if {[string length $bgcol]} {
		    puts "<tr bgcolor=\"$bgcol\">"
		} else {
		    puts "<tr>"
		}
		foreach {index col} $row {
		    if {[string length $col]} {
			puts $col
		    }
		}
		puts -nonewline "</tr>"
	    }
	    puts -nonewline $HR
	    return
	}

	set sep ""
	foreach {ty Name} {
	    c "Process TIPs"
	    i "Informational TIPs"
	    j "Project TIPs"
	} {
	    if {![info exist rows($ty)]} {continue}
	    puts "<tr><td colspan=\"4\"><b>$Name</b></td></tr>"
	    foreach row $rows($ty) {
		set bgcol [lindex $row 8]
		if {[string length $bgcol]} {
		    puts "<tr bgcolor=\"$bgcol\">"
		} else {
		    puts "<tr>"
		}
		foreach {index col} $row {
		    if {[string length $col]} {
			puts $col
		    }
		}
		puts -nonewline "</tr>"
	    }
	    puts -nonewline $HR
	}
	puts "<tr><td colspan=\"4\"><table width=\"99%\" border><tr><td\
		align=\"center\">"
	puts "<form method=\"GET\" action=\"search.html\"><p>Search archive\
		for TIPs containing: <input size=\"25\" name=\"search\"><br>\
		<input type=\"submit\" name=\"where\"\
		value=\"Search titles, keywords and abstracts\">&nbsp;<a\
		href=\"advancedsearch.html\">Advanced Search</a></p></form>"
	puts "</td></tr></table></td></tr>"
    }
    variable shortIndexLastAnchor 0
    proc index {kind {errorKind soft} {tpat *}} {
	global AuthorRE
	closecontext
	# Kinds of indices?  short, medium, long, bibtex
	switch -- $kind {
	    short {
		variable shortIndexLastAnchor
		foreachTIPreverse d {
		    if {![string match $tpat [string tolower $d(Type)]]} {
			continue
		    }
		    puts -nonewline "<p><a href=\"$d(TIP).html\" "
		    if {$d(TIP) != 10000 && !$shortIndexLastAnchor} {
			set shortIndexLastAnchor 1
			puts -nonewline "id=\"last\" "
		    }
		    set a [lindex $d(Author) 0]
		    regexp "^$AuthorRE" $a -> name
		    puts "title=\"Author: $name"
		    puts "Type: $d(Type)"
		    puts "State: $d(State)"
		    puts -nonewline "Voting: $d(Vote)\""
		    puts -nonewline "><font size=\"2\">TIP #$d(TIP):"
		    switch -glob -- $d(State),$d(Vote) {
			"*,In progress" {
			    puts -nonewline " <font\
				    color=\"yellow\">Voting</font>"
			}
			"Draft,No voting" {
			    # No special tag
			}
			Accepted,* {
			    puts -nonewline " <font\
				    color=\"#a0a0f0\">Accepted</font>"
			}
			Draft,* {
			    puts -nonewline " <font\
				    color=\"green\">Draft</font>"
			}
			Rejected,* {
			    puts -nonewline " <font\
				    color=\"red\">Rejected</font>"
			}
			Withdrawn,* {
			    puts -nonewline " <font\
				    color=\"red\">Withdrawn</font>"
			}
		    }
		    puts "<br>$d(Title)</font></a></p>"
		}
	    }
	    medium {
		global orderingColumn what
		puts "<blockquote><table width=\"85%\"><tr align=\"left\">"
		medidx $tpat $orderingColumn $what
		puts "</table></blockquote>"
	    }
	    long {
		longidx $tpat
	    }
	    default {
		if {[string compare $errorKind soft]} {
		    return -code error "Index style $kind not supported"
		}
		puts "<p align=\"justify\"><font color=\"red\">Index\
			style \"$kind\" not yet supported!</font></p>"
	    }
	}
    }

    if {![llength [info command ::imwidth::getImageWidth]]} {
	source $SRCDIR/imwidth.tcl
    }
    proc image {bodytext} {
	global ImageRE DOCDIR contenttypes
	closecontext
	set caption {}
	set w 0
	regexp $ImageRE [string trim $bodytext] -> url caption
	if {[regexp {^[-_a-zA-Z0-9]+$} $url]} {
	    foreach {ext type} [array get contenttypes] {
		# Order is random, but shouldn't matter.
		if {
		    [string match image/* $type] && 
		    [file exists [set f [file join $DOCDIR $url$ext]]]
		} then {
		    set w [::imwidth::getImageWidth $f]
		    set url $url$ext
		    break
		}
	    }
	}
	set imgtag [format {img src="%s"} $url]
	if {[string length $caption]} {
	    append imgtag " alt=\"[quoteLiteral $caption]\""
	}
	if {$w > 450} {
	    set imgtag "a href=\"$url\"><$imgtag width=\"85%\"></a"
	} elseif {$w > 0} {
	    append imgtag " width=\"$w\""
	}
	puts "<div align=\"center\"><p><$imgtag></p></div>"
    }

    proc fmtauthor {author tip} {
	global AuthorRE
	regexp "^$AuthorRE$" $author -> name email
	return [xformauthor $name $email $tip 1]
    }

    proc generateTIPHeader {head {revisioninfo {}}} {
	# generate HTML header
	array set h $head
	global BASETARG BASEURL CSSURL ICONURL
	puts "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"\
		\"http://www.w3.org/TR/REC-html40/loose.dtd\">"
	if {[string length $revisioninfo]} {
	    set title "TIP #$h(TIP) Version $revisioninfo: $h(Title)"
	} else {
	    set title "TIP #$h(TIP): $h(Title)"
	}
	puts "<html><head><title>$title</title>"
	puts "<meta http-equiv=\"Content-Type\"\
		content=\"text/html; charset=iso-8859-1\">"
	puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
	puts "<base href=\"$BASEURL\" target=\"$BASETARG\">"
	if {[info exist h(Keywords)]} {
	    set keywords [join $h(Keywords) ", "]
	    puts "<meta name=\"Keywords\" content=\"$keywords\">"
	}
	puts "<link rel=\"stylesheet\" type=\"text/css\"\
		title=\"My standard style\" href=\"$CSSURL\">"
	puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
	puts "</head><body bgcolor=\"#d9d9d9\">"
	if {[string length $revisioninfo]} {
	    puts "<h1>$title</h1><p align=\"justify\"><em>This is not\
		    necessarily the <a href=\"$h(TIP).html\"\
		    onmouseover=\"window.status='View current version';\
		    return true\">current version</a> of this\
		    TIP.</em></p><hr><table>"
	} else {
	    puts "<h1>$title</h1><hr><table>"
	}
	variable thisTIPnumber $h(TIP)
	puts "<tr><td align=\"right\">TIP:</td><td>$h(TIP)</td></tr>"
	puts "<tr><td align=\"right\">Title:</td><td>$h(Title)</td></tr>"
	puts "<tr><td align=\"right\">Version:</td\
		><td><tt>$h(Version)</tt></td></tr>"
	switch [llength $h(Author)] {
	    0 {}
	    1 {
		set a [fmtauthor [lindex $h(Author) 0] $h(TIP)]
		puts "<tr><td align=\"right\">Author:</td><td>$a</td></tr>"
	    }
	    default {
		puts "<tr><td align=\"right\"\
			valign=\"baseline\">Authors:</td><td>"
		foreach a $h(Author) {puts "[fmtauthor $a $h(TIP)]<br>"}
		puts "</td></tr>"
	    }
	}
	foreach tag {State Type Tcl-Version Vote Votes-For Votes-Against Votes-Abstained} {
	    if {[info exist h($tag)] && [string length $h($tag)]} {
		puts "<tr><td\
			align=\"right\">${tag}:</td><td>$h($tag)</td></tr>"
	    }
	}
	set t [clock format $h(Created) -format {%A, %d %B %Y} -gmt 1]
	puts "<tr><td align=\"right\">Created:</td><td>$t</td></tr>"
	if {[info exist h(Vote-By)]} {
	    set t [clock format $h(Vote-By) -gmt 1 \
		    -format {%A, %d %B %Y, %H:%M GMT}]
	    if {$h(Vote-By) > [clock seconds]} {
		puts "<tr><td align=\"right\">Vote-By:</td><td>$t</td></tr>"
	    } else {
		puts "<tr><td align=\"right\">Vote-By:</td><td>$t\
			<i>(Vote Closed)</i></td></tr>"
	    }
	}
	foreach tag {Post-History} {
	    if {[string length $h($tag)]} {
		puts "<tr><td\
			align=\"right\">${tag}:</td><td>$h($tag)</td></tr>"
	    }
	}
	if {
	    [info exist h(Discussions-To)] &&
	    [string length $h(Discussions-To)]
	} {
	    foreach dt [split $h(Discussions-To) ,] {
		set dt [string trim $dt]
		puts -nonewline "<tr><td\
			align=\"right\">Discussions To:</td><td>"
		global URLRE
		if {[regexp ^$URLRE$ $dt]} {
		    puts "<a href=\"$dt\">$dt</a></td></tr>"
		} else {
		    puts "$dt</td></tr>"
		}
	    }
	}
	foreach tag {Obsoletes Obsoleted-By} {
	    if {[info exist h($tag)] && [string length $h($tag)]} {
		puts "<tr><td align=\"right\">${tag}:</td><td><a\
			href=\"$h($tag)\">TIP #$h($tag)</a></td></tr>"
	    }
	}
	if {[info exist h(Keywords)]} {
	    puts "<tr><td align=\"right\" valign=\"baseline\"\
		    >Keywords:</td><td>[join $h(Keywords) {, }]</td></tr>"
	}
	puts "</table><hr>"
    }

    proc clickelem {url mouseover text} {
	upvar elems elems
	regsub -all { } $text {\&nbsp;} text
	lappend elems [format "\[<a href=\"%s\"\
		title=\"%s\" onmouseover=\"window.status='%s';\
		return true\">%s</a>\]" $url $mouseover $mouseover $text]
    }
    proc generateDocument {head body {revision ""}} {
	array set h $head
	generateTIPHeader $head $revision

	# generate HTML body
	foreach par $body {
	    eval [intuitParagraphKind $par]
	}

	# generate HTML footer
	separator
	global FOOTERTEXT FEATURE CVSWEBURL EDITURLBASE
	global TCLLOGOURL TCLLOGOX TCLLOGOY
	if {[string length $revision]} {
	    puts "<p align=\"justify\"><img alt=\"Powered by Tcl\"\
		    src=\"$TCLLOGOURL\" width=\"$TCLLOGOX\"\
		    height=\"$TCLLOGOY\" align=\"right\"><em>This is not\
		    necessarily the <a href=\"$h(TIP).html\"\
		    onmouseover=\"window.status='View current version';\
		    return true\">current version</a> of this\
		    TIP.</em></p><address>$FOOTERTEXT</address></body></html>"
	    return
	}
	set elems {}
	clickelem 1.html "Go to the index page" Index
	if {$FEATURE(CVSWEB)} {
	    clickelem [format $CVSWEBURL $h(TIP)] \
		    "Go to document history" History
	}
	if {($FEATURE(EDIT) || $FEATURE(EDIT_URL_HTML))&& ![notEditable? h]} {
	    clickelem $EDITURLBASE/$h(TIP) "Edit this TIP" Edit
	}
	clickelem $h(TIP).html "Format as HTML" "HTML Format"
	clickelem $h(TIP).tip "View source" "Source Format"
	clickelem $h(TIP).tex "Format as LaTeX" "LaTeX Format"
	clickelem $h(TIP).txt "Format as plain text" "Text Format"
	clickelem $h(TIP).xml "Format as XML" "XML Format"
	clickelem $h(TIP).ms "Format as *roff with -ms macro package" \
		"*roff Format <i>(experimental)</i>"
	clickelem $h(TIP).rtf "Format as rich text" \
		"RTF Format <i>(experimental)</i>"
	puts "<p><img alt=\"Powered by Tcl\" src=\"$TCLLOGOURL\"\
		width=\"$TCLLOGOX\" height=\"$TCLLOGOY\"\
		align=\"right\">[join $elems]</p>"
	puts "<address>$FOOTERTEXT</address></body></html>"
    }
}

Added tipmode.el.












































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
;;; tipmode.el --- A mode for editing Tcl Improvement Proposals.

;; Copyright (C) 2000 Donal K. Fellows

(defconst tip-mode-revision-string "$Id: tipmode.el,v 1.13 2004/08/09 22:15:14 dkf Exp $"
  "Some CVS/RCS info relating to tipmode.el...")

;(require 'text)			; text-mode always available?

(defgroup tip nil "Major mode for editing Tcl Improvement Proposals."
  :group 'tcl
  :group 'text
  :prefix "tip-")

(defgroup tipface nil "Faces used when highlighting TIPs."
  :group 'tip
  :group 'faces)

(defcustom tip-mode-hook nil
  "Normal hook run when entering TIP mode."
  :type 'hook
  :group 'tip)

(defcustom tip-skeleton-head
  "TIP:		???
Title:		Title for Skeleton TIP
State:		Draft
Type:		Project
Tcl-Version:	9.0
Vote:		Pending
Post-History:	"
  "*A skeleton of a TIP header, minus certain derivable/computed fields."
  :type  'string
  :group 'tip)

(defcustom tip-skeleton-body "~ Abstract

A ''single'' paragraph, in third person voice, outlining what your TIP
is all about.

~ Rationale

Why is this TIP needed?

~ Proposed Change

What are you going to do?  ''This need not include a patch during
initial discussion, and should not include a verbatim patch at all
(due to publishing restrictions.)''

~ Copyright

This document has been placed in the public domain.
" "*A skeleton of a TIP body, a suitable place to start writing your own."
  :type 'string
  :group 'tip)



(defvar tip-header-key-face 'tip-header-key-face
  "Face name to use for keys in TIP headers.")
(defvar tip-header-value-face 'tip-header-value-face
  "Face name to use for values in TIP headers.")
(defvar tip-verbatim-face 'tip-verbatim-face
  "Face name to use for verbatim text in TIPs.")
(defvar tip-magic-paragraph-start-face 'tip-magic-paragraph-start-face
  "Face name to use for symbol sequences that start specially
meaningful paragraphs in TIPs.")
(defvar tip-section-title-face 'tip-section-title-face
  "Face name to use for section titles in TIPs.")
(defvar tip-magic-paragraph-info-face 'tip-magic-paragraph-info-face
  "Face name to use for extra info that follow paragraph starts with
special meaning in TIPs.")
(defvar tip-list-start-face 'tip-list-start-face
  "Face name to use for list item start sequences in TIPs.")
(defvar tip-uri-face 'tip-uri-face
  "Face name to use for URIs in TIPs.")

(defface tip-header-key-face		;copy of font-lock-builtin-face
  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
    (((class color) (background light)) (:foreground "Purple"))
    (((class color) (background dark)) (:foreground "Cyan"))
    (t (:bold t)))
  "Face for highlighting keys in TIP headers."
  :group 'tipface)
(defface tip-header-value-face		;copy of font-lock-function-name-face
  '((((class color) (background light)) (:foreground "Blue"))
    (((class color) (background dark)) (:foreground "LightSkyBlue"))
    (t (:inverse-video t :bold t)))
  "Face for highlighting values in TIP headers."
  :group 'tipface)
(defface tip-verbatim-face		;copy of font-lock-string-face
  '((((class grayscale) (background light)) (:foreground "DimGray" :italic t))
    (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
    (((class color) (background light)) (:foreground "RosyBrown"))
    (((class color) (background dark)) (:foreground "LightSalmon"))
    (t (:italic t)))
  "Face for highlighting verbatim paragraphs in TIPs."
  :group 'tipface)
(defface tip-magic-paragraph-start-face	;copy of font-lock-function-name-face
  '((((class color) (background light)) (:foreground "Blue"))
    (((class color) (background dark)) (:foreground "LightSkyBlue"))
    (t (:inverse-video t :bold t)))
  "Face for highlighting symbol sequences that start specially
meaningful paragraphs in TIPs."
  :group 'tipface)
(defface tip-magic-paragraph-info-face	;copy of font-lock-variable-name-face
  '((((class grayscale) (background light))
     (:foreground "Gray90" :bold t :italic t))
    (((class grayscale) (background dark))
     (:foreground "DimGray" :bold t :italic t))
    (((class color) (background light)) (:foreground "DarkGoldenrod"))
    (((class color) (background dark)) (:foreground "LightGoldenrod"))
    (t (:bold t :italic t)))
  "Face for highlighting extra info that follow paragraph starts with
special meaning in TIPs."
  :group 'tipface)
(defface tip-section-title-face		;copy of font-lock-constant-face
  '((((class grayscale) (background light))
     (:foreground "LightGray" :bold t :underline t))
    (((class grayscale) (background dark))
     (:foreground "Gray50" :bold t :underline t))
    (((class color) (background light)) (:foreground "CadetBlue"))
    (((class color) (background dark)) (:foreground "Aquamarine"))
    (t (:bold t :underline t)))
  "Face for highlighting section titles in TIPs."
  :group 'tipface)
(defface tip-list-start-face		;copy of font-lock-function-name-face
  '((((class color) (background light)) (:foreground "Blue"))
    (((class color) (background dark)) (:foreground "LightSkyBlue"))
    (t (:inverse-video t :bold t)))
  "Face for highlighting list item start sequences in TIPs."
  :group 'tipface)
(defface tip-uri-face
  '((t (:underline t)))
  "Face for highlighting URIs in TIPs."
  :group 'tipface)

(defvar tip-mode-syntax-table (make-syntax-table text-mode-syntax-table)
  "Syntax table used while in TIP mode.")

(defvar tip-mode-abbrev-table nil
  "Abbrev table used while in TIP mode.")
(define-abbrev-table 'tip-mode-abbrev-table ())

(defvar tip-mode-map () "Keymap for TIP mode.")
(if tip-mode-map
    ()
  (setq tip-mode-map (copy-keymap text-mode-map))
  (let ((map (make-sparse-keymap)))
    (define-key map "s" 'tip-insert-section-header)
    (define-key map "i" 'tip-insert-image)
    (define-key map "x" 'tip-insert-index)
    (define-key map "v" 'tip-verbatim-region)
    (define-key map "\C-c" 'tip-insert-skeleton)
    (define-key map "p" 'tip-check-spelling)
    (define-key map "h" 'tip-verify-headers)
    (define-key tip-mode-map "\C-c" map)
    (define-key tip-mode-map [menu-bar] (make-sparse-keymap))
    (define-key tip-mode-map [menu-bar tip]
      (cons "TIP" (make-sparse-keymap "TIP")))
    (define-key tip-mode-map [menu-bar tip verbatim-region]
      '("Verbatim Region" . tip-verbatim-region))
    (define-key tip-mode-map [menu-bar tip insert-image]
      '("Insert Image"    . tip-insert-image))
    (define-key tip-mode-map [menu-bar tip insert-index]
      '("Insert Index"    . tip-insert-index))
    (define-key tip-mode-map [menu-bar tip insert-section-header]
      '("Insert Section"  . tip-insert-section-header))
    (define-key tip-mode-map [menu-bar tip check-spelling]
      '("Check Spelling"  . tip-check-spelling))
    (define-key tip-mode-map [menu-bar tip verify-headers]
      '("Verify Headers"  . tip-verify-headers))
    (define-key tip-mode-map [menu-bar tip insert-skeleton]
      '("Insert Skeleton" . tip-insert-skeleton))
    (put 'tip-verbatim-region 'menu-enable 'mark-active)
  ))

(defvar tip-font-lock-keywords
  '(("^\\(#i\\(ndex\\|mage\\):\\)\\(\\S-*\\)"
     (1 tip-magic-paragraph-start-face) (3 tip-magic-paragraph-info-face))
    ("^\\(~\\)\\s-*\\(\\S-.*\\)"
     (1 tip-magic-paragraph-start-face) (2 tip-section-title-face))
    ("^\\(\\(T\\(IP\\|itle\\|ype\\)\\|\\(Tcl-\\)?Version\\|Author\\|State\\|Vote\\(-By\\|s-\\(For\\|A\\(gainst\\|bstained\\)\\)\\)?\\|Created\\|Post-History\\|Obsolete\\(s\\|d-By\\)\\|Keywords\\|Discussions-To\\):\\)[ \t]*\\(\\(\\S-.*\\)?\\)"
     (1 tip-header-key-face) (6 tip-header-value-face))
    ("^|.*" (0 tip-verbatim-face))
    ("^[ \t]+\\(\\(>\\s-+\\)*\\([*>]\\|[0-9]+.\\|.*:\\)\\)"
     (1 tip-list-start-face))
    ("\\(https?\\|ftp\\|news\\|newsrc\\|mailto\\|gopher\\):\\([-a-zA-Z0-9.]+:[0-9]+/\\)?[-A-Za-z0-9/_.%#[email protected]?=&;~]+"
     (0 tip-uri-face))
    ("tip:[0-9]+" (0 tip-uri-face))
    ("<\\(\\[email protected]\\S-+\\)>" (1 tip-uri-face)))
  "Default expressions to highlight in TIP mode.")
(defvar tip-font-lock-defaults
  '(tip-font-lock-keywords t nil nil mark-paragraph))
(defvar tip-imenu-generic-expression
  '((nil "^~\\s-*\\(.*\\)" 1)))
 
;;;###autoload
(defun tip-mode ()
  "Major mode for editing TIP documents.
The following keys are bound:
\\{tip-mode-map}
"
  (interactive)
  (text-mode)
  (set-syntax-table tip-mode-syntax-table)
  (use-local-map tip-mode-map)
  (make-local-variable 'imenu-generic-expression)
  (make-local-variable 'font-lock-defaults)
  (setq major-mode 'tip-mode
	mode-name  "TIP"
	local-abbrev-table       tip-mode-abbrev-table
	imenu-generic-expression tip-imenu-generic-expression
	font-lock-defaults       tip-font-lock-defaults
	)
  (imenu-add-to-menubar "Sections")
  (run-hooks 'tip-mode-hook)
  )

(defun tip-insert-paragraph (string)
  (or (bolp) (insert "\n"))
  (insert "\n" string "\n")
  (or (eolp) (insert "\n")))
(defun tip-insert-section-header (title)
  "Insert a section header paragraph."
  (interactive "*MSection title:")
  (tip-insert-paragraph (format "~ %s" title)))
(defun tip-insert-index (kind)
  "Insert an index paragraph."
  (interactive (list (completing-read "Index kind: "
				      [short medium long] nil t nil
				      nil "medium")))
  (tip-insert-paragraph (format "#index:%s" kind)))
(defun tip-insert-image (url caption)
  "Insert an image paragraph."
  (interactive "*sURL to reference: \nMCaption for image: ")
  (tip-insert-paragraph (format "#image:%s %s" url caption)))
(defun tip-verbatim-region (from to)
  "Makes the lines including the region into verbatim text."
  (interactive "*r")
  (let (fm tm)
    (goto-char from)
    (beginning-of-line)
    (setq fm (point-marker))
    (goto-char to)
    (or (bolp) (end-of-line))
    (setq tm (point-marker))
    (untabify fm tm)
    (goto-char fm)
    (while (< (point) tm)
      (beginning-of-line)
      (insert "|")
      (forward-line))
    (set-marker fm nil)
    (set-marker tm nil)))

(defun tip-insert-skeleton ()
  "Insert a skeleton TIP into the current buffer.
This allows people to get started writing a TIP much more rapidly."
  (interactive)
  (insert tip-skeleton-head)
  (insert (format "%cVersion:%c%cRevision%c" 10 9 36 36))
  (insert (format "%cAuthor:%c%c%s <%s>"
		  10 9 9 (user-full-name) user-mail-address))
  (insert (format-time-string "%nCreated:%t%d-%b-%Y"))
  (insert (format "%c%c" 10 10))
  (insert tip-skeleton-body))

;; Copied and adapted shamelessly from ispell.el!
(defun tip-check-spelling ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let* ((end-of-headers		; Start of body.
	    (copy-marker
	     (or (re-search-forward "^$" nil t)
		 (point-min))))
	   (limit (copy-marker		; End of region we will spell check.
		   (cond
		    ((not ispell-message-text-end) (point-max))
		    ((char-or-string-p ispell-message-text-end)
		     (if (re-search-forward ispell-message-text-end nil t)
			 (match-beginning 0)
		       (point-max)))
		    (t (min (point-max) (funcall
					 ispell-message-text-end))))))
	   (ispell-skip-region-alist
	    (cons (list "^|" (function forward-line))
		  ispell-skip-region-alist))
	   (old-case-fold-search case-fold-search)
	   (case-fold-search t)
	   (dictionary-alist ispell-message-dictionary-alist)
	   (ispell-checking-message t))
      (or (local-variable-p 'ispell-local-dictionary (current-buffer))
	  (while dictionary-alist
	    (goto-char (point-min))
	    (if (re-search-forward (car (car dictionary-alist))
				   end-of-headers t)
		(setq ispell-local-dictionary (cdr (car dictionary-alist))
		      dictionary-alist nil)
	      (setq dictionary-alist (cdr dictionary-alist)))))
      (unwind-protect
	  (progn
	    ;; Spell check any Title: or Keywords:
	    (goto-char (point-min))
	    (while (re-search-forward "^\\(Title\\|Keywords\\): *" end-of-headers t)
		(progn
		  (goto-char (match-end 0))
		  (let ((case-fold-search old-case-fold-search))
		    (ispell-region (point)
				   (progn ;Tab-initiated continuation lns.
				     (end-of-line)
				     (while (looking-at "\n[ \t]")
				       (end-of-line 2))
				     (point))))))
	    (goto-char end-of-headers)
	    (forward-line 1)
	    (ispell-region (point) limit))
	(set-marker end-of-headers nil)
	(set-marker limit nil)))))

(defconst tip-verify-states-re
  "^\\(Draft\\|Accepted\\|Deferred\\|Final\\|Active\\|Rejected\\|Withdrawn\\)$"
  "Regexp matching the acceptable values for the State: header field.")
(defconst tip-verify-types-re
  "^\\(Project\\|Process\\|Inform.*\\)$"
  "Regexp matching the acceptable values for the Type: header field.")
(defconst tip-verify-tclver-re
  "^[0-9]+\\.[0-9]+\\([.ab][0-9]+\\)?$"
  "Regexp matching the acceptable values for the Tcl-Version: header field.")
(defconst tip-verify-vote-re
  "^\\(Pending\\|In progress\\|Done\\|No voting\\)$"
  "Regexp matching the acceptable values for the Vote: header field.")
(defconst tip-verify-created-re
  "^[0-9][0-9]-\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)-20[0-9][0-9]$"
  "Regexp matching the acceptable values for the Created: header field.")
(defconst tip-verify-author-re
  "^.+ <[email protected]+>$"
  "Regexp matching the acceptable values for the Author: header field.")

(defconst tip-header-matcher-alist
  (list '("TIP" . "^[0-9]+$")
	'("Title" . ".")
	'("Version" . "^\$.+\$$")
	(cons "State" tip-verify-states-re)
	(cons "Type" tip-verify-types-re)
	(cons "Tcl-Version" tip-verify-tclver-re)
	(cons "Vote" tip-verify-vote-re)
	(cons "Created" tip-verify-created-re)
	(cons "Author" tip-verify-author-re)
	'("Obsoletes" . "^[0-9]_$")
	'("Obsoleted-By" . "^[0-9]_$")
	'("Post-History" . ".*")
	'("Discussions-To" . ".+")
	'("Keywords" . ".+")
	'("Vote-By" . ".+")
	'("Votes-For" . ".+")
	'("Votes-Against" . ".+")
	'("Votes-Abstained" . ".+"))
  "Alist of matchers for each of the legal TIP headers.")

(defun tip-verify-headers ()
  "Perform a basic verification check on the TIP headers."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let ((headers)
	  (end-of-headers		; Start of body.
	   (copy-marker
	    (or (re-search-forward "^$" nil t)
		(point-min)))))
      (goto-char (point-min))
      (while (re-search-forward "^\\([-a-zA-Z]+\\):[ \t]*\\(.*\\)"
				end-of-headers t)
	(let* ((key  (match-string 1))
	       (body (match-string 2))
	       (next (match-end 0))
	       (re   (assoc key tip-header-matcher-alist)))
	  	  (cond
	   ((not re) (error "Unknown header '%s:'" key))
	   ((string-match (cdr re) body)
	    (setq headers (cons (cons key body) headers)))
	   (t (error "Illegal header '%s: %s'" key body)))
	  (goto-char next)))
      (or (assoc "TIP" headers) (error "Missing header 'TIP:'"))
      (or (assoc "Title" headers) (error "Missing header 'Title:'"))
      (or (assoc "Version" headers) (error "Missing header 'Version:'"))
      (or (assoc "State" headers) (error "Missing header 'State:'"))
      (or (assoc "Type" headers) (error "Missing header 'Type:'"))
      (or (assoc "Vote" headers) (error "Missing header 'Vote:'"))
      (or (assoc "Created" headers) (error "Missing header 'Created:'"))
      (or (assoc "Author" headers) (error "Missing header 'Author:'"))
      (or (assoc "Post-History" headers) (error "Missing header 'Post-History:'"))
      (let ((project (equal "Project" (cdr (assoc "Type" headers))))
	    (tcl-version (assoc "Tcl-Version" headers)))
	(if (and (not project) tcl-version)
	    (error "Can only have 'Tcl-Version:' header in Project TIPs"))
	(if (and project (not tcl-version))
	    (error "Must have 'Tcl-Version:' header in Project TIPs")))
      (message "TIP headers seem OK"))))

;; Arrange for the mode to become associated with all buffers whose
;; filenames end in .tip, unless this has been done already...

(if (assoc "\\.tip\\'" auto-mode-alist) ()
  (setq auto-mode-alist (cons '("\\.tip\\'" . tip-mode) auto-mode-alist)))
(message "%s" tip-mode-revision-string)

(provide 'tipmode)

;; $Log: tipmode.el,v $
;; Revision 1.13  2004/08/09 22:15:14  dkf
;; Extend support for the new headers to the Emacs support
;;
;; Revision 1.12  2003/08/15 08:11:46  dkf
;; Omitted the Deferred state from the State: header checking RE.  D'oh!
;;
;; Revision 1.11  2002/02/20 09:21:06  dkf
;; URLs can contain '%' so add it to match set.
;;
;; Revision 1.10  2002/01/10 11:57:11  dkf
;; Now have correctly functioning TIP header verifier.
;;
;; Revision 1.9  2001/12/18 14:12:14  dkf
;; More advanced online searching and some verification ability in the emacs mode
;;
;; Revision 1.8  2001/09/04 09:34:03  dkf
;; Substantive enhancement to tipmode.el (spelling+menu)
;;
;; Revision 1.7  2001/03/09 14:26:51  dkf
;; Supported https URLs and added a skeleton TIP generation function.
;;
;; Revision 1.6  2000/12/01 10:56:50  dkf
;; Improved autoloading.
;;
;; Revision 1.5  2000/11/21 15:25:29  dkf
;; Added a batch of "useful" editing commands.
;;
;; Revision 1.4  2000/11/21 10:25:54  dkf
;; Improved highlight regexps.
;;
;; Revision 1.3  2000/11/17 15:11:16  dkf
;; Improved support for other people's use and removed a stupid
;; font-definition bug.
;;
;; Revision 1.2  2000/11/15 14:17:07  dkf
;; Bugfixes...
;;
;; Revision 1.1  2000/11/15 11:49:51  dkf
;; Tweaked the LaTeX generator to remind people to get the accompanying
;; images, and added an emacs mode for editing TIPs.
;;

Added tipms.tcl.




















































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
namespace eval tipms {
    proc putspar {string} {
	global TIPURLRE BASEURL ShortTIPRE ISSUEBASE ISSUEURLRE
	regsub -all {'''(('?[^'])+)'''} $string "\x82\\fB\\1\\fR" string
	regsub -all {''(('?[^'\x82])+)''} $string "\\fI\\1\\fR" string
	regsub -all $TIPURLRE $string "$BASEURL\\1.html" string
	regsub -all $ISSUEURLRE $string "$ISSUEBASE\\1" string
	regsub -all {\[\[} $string \x80 string
	regsub -all {\]\]} $string \x81 string
	regsub -all $ShortTIPRE $string "\[TIP #\\1\]" string
	regsub -all \x80 $string \[ string
	regsub -all \x81 $string \] string
	regsub -all \x82 $string {} string
	if {[string match .* $string]} {
	    puts "\\$string"
	} else {
	    puts $string
	}
    }

    variable counters {}
    proc manageListCounters {level num} {
	variable counters
	if {
	    [regexp {^1$} $num] &&
	    $level < [llength $counters] &&
	    [lindex $counters $level] != "*"
	} then {
	    set num [lindex $counters $level]
	    incr num
	}
	set counters [lrange [linsert $counters $level $num] 0 $level]
	return [lindex $counters end]
    }
    variable incontext -1

    proc setcontext {{level -1}} {
	variable incontext
	for {} {$incontext > $level} {incr incontext -1} {puts .RE}
	for {} {$incontext < $level} {incr incontext} {puts .RS}
    }
    proc endcount {} {
	variable counters {}
    }

    proc section {title {level 1}} {
	setcontext
	endcount
	puts ".NH $level\n\\fB$title\\fR"
    }
    proc ordinary {string} {
	endcount
	continuation -1 $string
    }
    proc item {tag level body} {
	incr level -1
	setcontext $level
	puts ".IP $tag"
	putspar $body
    }
    proc bulleting {level body} {
	manageListCounters $level *
	set s [lindex {bu sq hy} [expr {$level % 3}]]
	item "\\ \\($s" $level $body
    }
    proc enumeration {tag level body} {
	set tag [manageListCounters $level $tag]
	item "\" ${tag}: \"" $level $body
    }
    proc description {tag level body} {
	manageListCounters $level *
	item "\"$tag \"" $level $body
    }
    proc continuation {level body} {
	variable incontext
	if {$level != -1 && $incontext<0} {
	    puts .QP
	} else {
	    if {$level > 0} {
		setcontext [expr {$level-1}]
	    } else {
		setcontext $level
	    }
	    puts .LP
	}
	putspar $body
    }
    proc separator {} {
	endcount
	setcontext
	puts .Hl
    }
    proc verbatim {lines} {
	puts .LD
	foreach string $lines {
	    regsub -all "\[ \t\]" $string {\\&} string
	    if {[string match .* $string]} {
		puts "\\$string"
	    } else {
		puts $string
	    }
	}
	puts .DE
    }
    proc index {kind {errorKind soft} {tpat *}} {
	endcount
	setcontext
	switch -- $kind {
	    medium {
		puts ".TS H\ncenter;\nlb|lb|lb|lb."
		puts "Series ID\tType\tState\tTitle\n_\n.TH"
		puts ".T&\nl|l|l|lw(3.5i)."
		foreachTIP d {
		    if {[string compare $d(Vote) "In progress"]} {
			set v $d(State)
		    } else {
			set v Voting
		    }
		    set t $d(Type)
		    if {[string match Info* $t]} {set t Info.}
		    puts "TIP #$d(TIP)\t$t\t$v\t\\fI$d(Title)\\fR"
		}
		puts ".TE"
	    }
	    short {
		puts ".CD\n.TS\nc l.\n\\fBSeries ID\\fR\t\\fBTitle\\fR"
		foreachTIP d {
		    puts "TIP #$d(TIP)\t$d(Title)"
		}
		puts ".TE\n.DE"
	    }
	    default {
		if {[string compare $errorKind soft]} {
		    return -code error "Index style $kind not supported"
		}
		set msg "*Index style \"$kind\" not yet supported*"
		regsub -all . $msg * stars
		puts ".CD\n$stars\n$msg\n$stars\n.DE"
	    }
	}
    }
    proc image {bodytext} {
	endcount
	setcontext
	global ImageRE
	puts .CD
	if {
	    [regexp $ImageRE $bodytext -> url caption] &&
	    [regexp {^[-_a-zA-Z0-9]+$} $url]
	} then {
	    global DOCDIR
	    set fn [file join $DOCDIR $url.txt]
	    if {[file isfile $fn] && [file readable $fn]} {
		set f [open $fn r]
		set lines [split [read -nonewline $f] "\n"]
		close $f
		foreach line $lines {
		    puts " $line"
		}
		puts ""
		putspar $caption
	    }
	} elseif {[info exist url] && [info exist caption]} {
	    puts "<URL:$url>"
	    putspar $caption
	} else {
	    puts "<<$bodytext>>"
	}
	puts .DE
    }
    proc generateDocument {head body} {
	array set h $head
	puts {.\" t
.\" Note that this file *must* be preprocessed with tbl before being
.\" passed to *roff.  Fail to do this and things will break...
.de Hl
.br
\l'\\n(.lu-\\n(.iu'
.sp
..}
	puts ".TL\nTIP #$h(TIP): $h(Title)\n"
	puts ".AU\n[join $h(Author) ,\n]"
	puts [clock format $h(Created) -format ".DA \"%d %b %Y\"" -gmt 1]
        switch $h(State) {
	    Accepted - Final - Active {
		puts ".AI\nTcl Core Team"
	    }
	    Draft {
		puts ".AI\n.BX DRAFT"
	    }
	}
	puts .AB
	putspar [lindex [intuitParagraphKind [lindex $body 1]] 1]
	puts .AE
	puts ".TS\nbox;\nlb | lb.\nTIP #$h(TIP):\t$h(Title)"
	puts "_\n.T&\nl | l."
	foreach hdr {
	    Type State Vote Version Tcl-Version Post-History Discussions-To
	    Obsoletes Obsoleted-By Keywords Votes-For Votes-Against
	    Votes-Abstained
	} {
	    if {![info exist h($hdr)]} {continue}
	    puts "${hdr}:\t$h($hdr)"
	}
	if {[info exist h(Vote-By)]} {
	    puts [clock format $h(Vote-By) -gmt 1 \
		    -format "Vote-By:\t%d %b %Y, %H:%M GMT"]
	}
	puts .TE
	puts .1C
	foreach par [lrange $body 2 end] {
	    eval [intuitParagraphKind $par]
	}
	puts ".SH\nColophon\n.LP"
	global FOOTERTEXT
	puts $FOOTERTEXT
    }
}

Added tiprtf.tcl.




































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
# TIP to RTF generator v0.1
# No indices nor images supported
# No TIP headers generation
# Juan C. Gil <mailto:[email protected]>
namespace eval tiprtf {
    variable FONT
    array set FONT {SANS 0 SERIF 1 TYPE 2 SYMB 3}

    # The indent amount
    variable indent 426

    # Enumeration counters
    variable counters [list]

    # Generates the RTF header
    proc RTF-documentHeader {tipnum title} {
	puts "\{\\rtf1\\ansi\\ansicpg1252\\deff0\\deflang3082\
		\n{\\fonttbl\n{\\f0\\fswiss\\fcharset0\
		Arial;}\n{\\f1\\froman\\fprq2\\fcharset0 Times New\
		Roman;}\n{\\f2\\fmodern\\fprq1\\fcharset0 Courier\
		New;}\n{\\f3\\fnil\\fcharset2 Symbol;}\n}\
		\n\\viewkind4\\uc1\
		\n\\paperw11907\\paperh16840\\margl1797\\margr1797\n"
	RTF-paragraph SANS 32 200 0 0 "\\b TIP #${tipnum}: $title\\b0"
	separator
    }

    # Generates the RTF header
    proc RTF-documentTrailer {} {
	puts \}
    }

    # Generates a section heading
    proc section {title {level 1}} {
	variable counters [list]
	if {$level > 4} {set level 4}
	set size [lindex {32 24 20 16 14} $level]
	RTF-paragraph SANS $size [expr {int($size*12)}] 0 0 $title
    }

    # Generates an RTF paragraph heading
    # f  = font
    # fs = font size
    # sb = space between paragraphs
    # li = left indent
    # fi = first line indent
    proc RTF-paragraph-heading {f fs sb li fi} {
	variable FONT
	puts [format {\pard\f%s\fs%s\sb%s\li%s\fi%s} \
		$FONT($f) $fs $sb $li $fi]
    }
    # Generates an RTF paragraph with leading and trailing matter
    # All args as above, plus:
    # str = body of the paragraph
    proc RTF-paragraph {f fs sb li fi str} {
	RTF-paragraph-heading $f $fs $sb $li $fi
	puts "$str\\par\n"
    }

    if {[catch {string repeat _ 77}]} {
	proc strrep {str count} {
	    regsub -all " " [format %*s $count ""] $str var
	    set var
	}
    } else {
	interp alias {} [namespace current]::strrep {} string repeat
    }
    # Generates a separator
    proc separator {} {
	variable counters [list]
	RTF-paragraph SERIF 20 0 0 0 [strrep _ 77]
    }

    # Generates a verbatim paragraph
    proc verbatim {lines} {
	variable indent
	set sb 120
	foreach line $lines {
	    RTF-paragraph TYPE 20 $sb $indent 0 $line
	    set sb 0
	}
    }

    # Generates a paragraph
    proc paragraph {body {level 0} {bullet 0} {outdent 0} {usesTabs 0}} {
	variable indent

	# NEED PROCESSING FOR BACKSLASH CHARACTERS AND OTHER ESCAPES!

	# Bold and emphasis
	regsub -all {'''(('?[^'])+)'''} $body "\x81\\b \\1\\b0 " body
	regsub -all {''(('?[^'\x81])+)''} $body "\\i \\1\\i0 " body
	regsub -all \x81 $body "" body

	set li [expr {$level * $indent}]
	if {$outdent} {
	    incr li $indent
	    RTF-paragraph-heading SERIF 20 120 $li -$indent
	} else {
	    RTF-paragraph-heading SERIF 20 120 $li 0
	}
	if {$usesTabs} {
	    set tab $indent
	    foreach i {1 2 3 4 5} {
		puts -nonewline [format {\tx%s} $tab]
		incr tab $indent
	    }
	    puts {}
	}
	if {$bullet} {
	    puts {{\*\pn\pnlvlblt\pnf3\pnindent0{\pntxtb\'B7}}}
	}
	puts "$body\\par\n"
    }

    # Manages the enumeration counters
    proc manage-counters {level number} {
	variable counters
	if {
	    ![string compare $number 1] &&
	    $level < [llength $counters] &&
	    [string compare [lindex $counters $level] *]
	} then {
	    set number [lindex $counters $level]
	    incr number
	}
	set counters [lrange [linsert $counters $level $number] 0 $level]
	return [lindex $counters end]
    }

    # Generates an enumerated item
    proc enumeration {tag level body} {
	paragraph "[manage-counters $level $tag].\\tab $body" $level 0 1 1
    }

    # Generates a description item
    proc description {tag level body} {
	manage-counters $level *
	paragraph "\\b $tag\\b0\\tab $body" $level 0 1 1
    }

    # Generates a bulleted item
    proc bulleting {level body} {
	manage-counters $level *
	paragraph $body $level 1 1
    }

    # Generates a continuation paragraph
    proc continuation {level body} {
	paragraph $body $level
    }

    # Generates an ordinary paragraph
    proc ordinary {body} {
	variable counters [list]
	paragraph $body
    }

    proc index {args} {
	RTF-paragraph SANS 10 120 0 0 "indexes not implemented"
    }
    proc image {args} {
	RTF-paragraph SANS 10 120 0 0 "images not implemented"
    }

    proc RTF-tablerow {part1 part2 {font SERIF}} {
	variable FONT
	RTF-paragraph SERIF 11 0 0 0 "${part1}:\\tab{\\f$FONT($font) $part2}"
    }

    # Generates the RTF document
    proc generateDocument {head body} {
	array set header $head

	# Generate the RTF header
	RTF-documentHeader $header(TIP) $header(Title)

	# Generate the content header table
	puts "\{\\tx1440"
	RTF-tablerow TIP     $header(TIP)
	RTF-tablerow Title   $header(Title)
	RTF-tablerow Version $header(Version) TYPE
	RTF-tablerow Authors [join $header(Author) "\\line\\tab "]
	RTF-tablerow State   $header(State)
	RTF-tablerow Type    $header(Type)
	if {[info exist header(Tcl-Version)]} {
	    RTF-tablerow Tcl-Version $header(Tcl-Version)
	}
	RTF-tablerow Vote    $header(Vote)
	RTF-tablerow Created [clock format $header(Created)]
	if {[info exist header(Keywords)]} {
	    RTF-tablerow Keywords [join $header(Keywords) ", "]
	}
	puts "\}"

	# Loop over paragraphs
	foreach par $body {
	    eval [intuitParagraphKind $par]
	}

	# Generate the content trailer
	global   FOOTERTEXT
	separator
	section  Colophon
	ordinary $FOOTERTEXT

	# Generate the RTF trailer
	RTF-documentTrailer
    }
}

Added tiptex.tcl.






























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
source $SRCDIR/imwidth.tcl
source $SRCDIR/epstopdf.tcl
namespace eval tiptex {
    variable idxnum 0
    variable citations
    array set citations {}
    proc quote {body {dbs 0}} {
	if {$dbs} {
	    regsub -all {\\} $body {\(\backslash\)} body
	    regsub -all {([{}])} $body {\\\1} body
	}
	regsub -all {LaTeX } $body {LaTeX\\ } body
	regsub -all {LaTeX[^a-zA-Z]} $body {\\&} body
	regsub -all <    $body {\tiplangle{}} body
	regsub -all >    $body {\tiprangle{}} body
	regsub -all {\|} $body {\tipbar{}} body
	#regsub -all {[<>|]} $body {\(&\)} body
	regsub -all {\^} $body {\textasciicircum{}} body
	regsub -all {([%&_$#])} $body {\\\1} body
	regsub -all ~ $body {\~{}} body
	regsub -all { - } $body " \x80 " body
	regsub -all {([0-9])--([0-9])} $body "\\1\x81\\2" body
	while {[regsub -- -- $body "-{}-" body]} {}
	regsub -all "\x80" $body --- body
	regsub -all "\x81" $body -- body
	# TeX does not use a standard encoding.  Damn!
	regsub -all "\xa9" $body {(c)} body
	regsub -all "\xe1" $body {\'{a}} body
	regsub -all "\xe9" $body {\'{e}} body
	regsub -all "\xef" $body {\"{\i}} body
	regsub -all "\xf1" $body {\~{n}} body
	regsub -all "\xf3" $body {\'{o}} body
	regsub -all "\xf4" $body {\^{o}} body
	return $body
    }
    proc paragraph {body} {
	global EmailRE URLRE TIPURLRE ShortTIPRE BASEURL ISSUEBASE ISSUEURLRE
	variable mode
	regsub -all $EmailRE $body "\x82\\1\x83" body
	regsub -all $TIPURLRE $body "$BASEURL\\1.tex" body
	regsub -all $ISSUEURLRE $body "$ISSUEBASE\\1" body
	regsub -all {\\} $body {\(\backslash\)} body
	regsub -all {([{}])} $body {\\\1} body
	regsub -all {'''(('?[^'])+)'''} $body "\x89\\textbf{\\1}" body
	regsub -all {''(('?[^'\x89])+)''} $body "\\textit{\\1}" body
	regsub -all \x89 $body {} body
	regsub -all {''+} $body {\(&\)} body
	regsub -all "\"(\[^\"\]+)\"" $body "``\\1''" body

	set txt $body
	set body {}
	while {[regexp -indices $URLRE $txt match]} {
	    foreach {f t} $match {}
	    set pre [string range $txt 0 [expr {$f-1}]]
	    set url [string range $txt $f $t]
	    set post [string range $txt [expr {$t+1}] end]
	    regsub -all ~ $url "\x84" url
	    regsub -all & $url "\x85" url
	    regsub -all _ $url "\x86" url
	    append body $pre "\\url{" $url "}"
	    set txt $post
	}
	append body $txt

	regsub -all {\[\[} $body \x87 body
	regsub -all {\]\]} $body \x88 body
	switch $mode {
	    one {
		regsub -all $ShortTIPRE $body "\\cite{tip\\1}" body
	    }
	    all {
	    	 regsub -all $ShortTIPRE $body \
	    		 "\\hyperlink{tip\\1}{TIP ##\\1}" body
	    }
	    default {
		error "unknown mode \"$mode\""
	    }
	}

	set body [quote $body]
	while {[regsub "(\x82\[^\x82\x83\]*)\\\\_(\[^\x82\x83\]*\x83)" $body \
		{\1_\2} body]} {
	    # Underscores must not be quoted inside a \tipmail command
	}
	regsub -all "\x82(\[^ @\x82\x83]+)@(\[^ @\x82\x83]+)\x83" $body \
		"\\tipmail{\\1}{\\2}" body
	regsub -all "\x84" $body ~   body
	regsub -all "\x85" $body \\& body
	regsub -all "\x86" $body _   body
	regsub -all "\x87" $body \[ body
	regsub -all "\x88" $body \] body
	puts $body
	# now, we need to find the citations made...
	variable citations
	while {[regexp -indices {\\cite{tip([0-9]+)}} $body -> idxpair]} {
	    foreach {x y} $idxpair {}
	    set cite [string range $body $x $y]
	    set body [string range $body $y end]
	    set citations($cite) 1
	}
    }

    variable contexts {}
    proc closecontext {} {
	variable contexts
	foreach c $contexts {
	    puts "\\end{$c}"
	}
	puts ""
	set contexts {}
    }
    proc closetolevel {level} {
	variable contexts
	while {[llength $contexts] > $level} {
	    set c [lindex $contexts 0]
	    set contexts [lrange $contexts 1 end]
	    puts "\\end{$c}"
	}
    }
    proc startcontext {type} {
	variable contexts
	set contexts [linsert $contexts 0 $type]
	puts "\\begin{$type}"
    }
    proc changecontext {type} {
	variable contexts
	set cold [lindex $contexts 0]
	if {[string compare $type $cold]} {
	    puts "\\end{$cold}\n\\begin{$type}"
	    set contexts [lreplace $contexts 0 0 $type]
	}
    }
    proc liststart {level type} {
	closetolevel [incr level]
	variable contexts
	if {[llength $contexts] == $level} {
	    changecontext $type
	} else {
	    startcontext $type
	}
    }

    proc bulleting {level body} {
	liststart $level itemize
	puts "\\item{}"
	paragraph $body
    }
    proc description {tag level body} {
	liststart $level description
	puts "\\item\[[quote $tag 1]\]"
	paragraph $body
    }
    proc enumeration {tag level body} {
	liststart $level enumerate
	if {$tag != 1} {
	    incr tag -1
	    set d 0
	    variable contexts
	    foreach c $contexts {if {![string compare $c enumerate]} {incr d}}
	    switch $d {
		1 {puts "\\setcounter{enumi}{$tag}"}
		2 {puts "\\setcounter{enumii}{$tag}"}
		3 {puts "\\setcounter{enumiii}{$tag}"}
		4 {puts "\\setcounter{enumiv}{$tag}"}
	    }
	}
	puts "\\item{}"
	paragraph $body
    }
    proc continuation {level body} {
	variable contexts
	if {[llength $contexts] == 0 && $level == 1} {
	    puts "\n\\begin{quote}"
	    paragraph $body
	    puts "\\end{quote}"
	    return
	}
	closetolevel $level
	puts ""
	paragraph $body
    }

    proc section {title {level 1}} {
	variable idxnum
	closecontext
	set cmd {}
	for {set i 1} {$i<$level} {incr i} {append cmd sub}
	puts "\\[append cmd section]{[quote $title 1]}"
    }
    proc image {bodytext} {
	global ImageRE DOCDIR BASEURL
	variable idxnum
	regexp $ImageRE [string trim $bodytext] -> url caption
	closecontext
	puts "\\begin{figure}\[htbp\]\\begin{center}\\leavevmode"
	if {
	    [regexp {^[-_a-zA-Z0-9]+$} $url] &&
	    [file exists [set fn [file join $DOCDIR $url.eps]]]
	} then {
	    puts "\\tipimage{$url}{[::imwidth::getImageWidth $fn]pt}"
	} else {
	    puts "\\fbox{\\tiny\\url{$url}}"
	}
	puts "\\caption{[quote $caption 1]}"
	puts "\\end{center}\\end{figure}"
    }
    proc ordinary {body} {
	closecontext
	paragraph $body
    }
    proc separator {} {
	closecontext
	puts "\\vspace{3ex}\\hrule\\vspace{1.5ex}"
    }
    proc verbatim {lines} {
	puts "\\begingroup\\small\\begin{verbatim}"
	foreach line $lines {
	    # Ugh!  LaTeX chokes on formfeed characters in verbatim,
	    # which tend to be common in quoted patches to the core...
	    regsub -all { } $line ^L line
	    puts $line
	}
	puts "\\end{verbatim}\n\\endgroup"
    }
    proc shorten {length string} {
	if {$length+2 >= [string length $string]} {return $string}
	return [string range $string 0 $length].
    }
    proc index {kind {errorKind soft}} {
	closecontext
	switch -- $kind {
	    short {
		foreachTIP d {
		    set num "TIP #$d(TIP):"
		    switch $d(State) {
			Draft - Rejected - Withdrawn {
			    set state "(\\emph{$d(State)})"
			}
			default {set state ""}
		    }
		    puts "[quote $num] $state"
		    paragraph $d(Title)
		    puts ""
		}
	    }
	    medium {
		puts "\\begin{center}\\begin{supertabular}{c|ll|p{2.5in}}"
		puts "\\textbf{TIP ID}&\\textbf{Type}&\\textbf{State}&\
			\\textbf{Title}\\\\\\hline"
		foreachTIP d {
		    puts -nonewline "\\small TIP \\#$d(TIP)&\\small\
			    [shorten 5 $d(Type)]&\\small\
			    [shorten 4 $d(State)]&\\small "
		    paragraph $d(Title)
		    puts -nonewline "\\\\"
		}
		puts "\\end{supertabular}\\end{center}"
	    }
	    long {
		puts "\\begin{center}\\begin{supertabular}{|lp{3.3in}|}\\hline"
		set docsep ""
		foreachTIP d {
		    puts $docsep
		    puts -nonewline "\\textbf{TIP \\#$d(TIP)}:&"
		    puts "\\textbf{[quote $d(Title)]}\\\\"
		    puts "Version:&\\tipversion$d(Version)\\\\"

		    regsub -all "\t" $d(Author) " " authorNotab
		    if {[llength $d(Author)] == 1} {
			puts -nonewline "Author:&"
			paragraph [lindex $authorNotab 0]
			puts "\\\\"
		    } else {
			puts -nonewline "Authors:&"
			paragraph [lindex $authorNotab 0]
			foreach a [lrange $authorNotab 1 end] {
			    puts -nonewline "\\par "
			    paragraph $a
			}
			puts "\\\\"
		    }

		    puts "State:&$d(State)\\\\Type:&$d(Type)\\\\"
		    if {[info exist d(Tcl-Version)]} {
			puts "Tcl Version:&$d(Tcl-Version)\\\\"
		    }
		    puts "Vote:&$d(Vote)\\\\"
		    puts [clock format $d(Created) -gmt 1 \
			    -format "Created:&%d %B %Y\\\\"]
		    puts "Posting History:&"
		    set ph ""
		    foreach event [split $d(Post-History) ","] {
			puts $ph[quote [string trim $event]]
			set ph "\\par "
		    }
		    puts "\\\\"
		    if {[info exist d(Discussions-To)]} {
			regsub -all {,} $d(Discussions-To) {, } dt
			puts "Discussions To:&[quote $dt]\\\\"
		    }
		    if {[info exist d(Obsoletes)]} {
			puts "Obsoletes:&TIP \\#$d(Obsoletes)\\\\"
		    }
		    if {[info exist d(Obsoleted-By)]} {
			puts "Obsoleted By:&TIP \\#$d(Obsoleted-By)\\\\"
		    }
		    if {[info exist d(Vote-By)]} {
			if {$d(Vote-By) > [clock seconds]} {
			    set inf ""
			} else {
			    set inf " (closed)"
			}
			puts [clock format $d(Vote-By) -gmt 1 \
				-format "Vote By:&%d %B %Y, %H:%M GMT$inf\\\\"]
		    }
		    if {[info exist d(Votes-For)]} {
			puts "Votes For:&$d(Votes-For)\\\\"
		    }
		    if {[info exist d(Votes-Against)]} {
			puts "Votes Against:&$d(Votes-Against)\\\\"
		    }
		    if {[info exist d(Votes-Abstained)]} {
			puts "Votes Abstained:&$d(Votes-Abstained)\\\\"
		    }
		    if {[info exist d(Keywords)]} {
			puts "Keywords:&[quote [join $d(Keywords) {, }]]\\\\"
		    }
		    puts "&\\\\Abstract:&"
		    paragraph $d(Abstract)
		    set docsep "\\\\\\hline\\hline"
		}
		puts "\\\\\\hline\\end{supertabular}\\end{center}"
	    }
	    default {
		puts "\\fbox{\\textbf{Index ``$kind'' not yet supported}}"
	    }
	}
    }

    proc generateDocumentHeader {headerArrayName {emptyPage 1} {targ {}}} {
	upvar $headerArrayName h

	puts "\\begin{center}\\begin{tabularx}{\\linewidth}{|[email protected]{: }X|}\\hline"
	if {[string length $targ]} {
	    puts [format {\hypertarget{%s}{\textbf{%s}}&\textbf{%s}\\\hline} \
		    $targ [quote "TIP #$h(TIP)" 1] [quote $h(Title) 1]]
	} else {
	    puts [format "\\textbf{%s}&\\textbf{%s}\\\\\\hline" \
		    [quote "TIP #$h(TIP)" 1] [quote $h(Title) 1]]
	}
	puts [quote Author 1]&
	set sep ""
	foreach a $h(Author) {
	    puts $sep; set sep "\\par"
	    paragraph $a
	}
	puts "\\\\"
	set d [clock format $h(Created) -gmt 1 -format %d]
	switch $d {
	    01 - 21 - 31 { set ord st }
	    02 - 22      { set ord nd }
	    03 - 23      { set ord rd }
	    default      { set ord th }
	}
	set d [string trimleft $d 0]
	puts [clock format $h(Created) -gmt 1 -format \
		"Created&%A, \\(\\text{$d}^{\\text{$ord}}\\) %B %Y\\\\"]
	puts "Type&$h(Type)\\\\"
	if {[info exist h(Tcl-Version)]} {
	    regsub a $h(Tcl-Version) \\alpha h(Tcl-Version)
	    regsub b $h(Tcl-Version) \\beta  h(Tcl-Version)
	    puts "Tcl Version&\\($h(Tcl-Version)\\)\\\\"
	    unset h(Tcl-Version)
	}
	puts "State&$h(State)\\\\"
	puts "Vote&$h(Vote)\\\\"
	puts "Version&\\tipversion$h(Version)\\\\"
	if {[info exist h(Keywords)]} {
	    puts "Keywords&[quote [join $h(Keywords) {, }] 1]\\\\"
	    unset h(Keywords)
	}
	if {[info exist h(Vote-By)]} {
	    if {$h(Vote-By) > [clock seconds]} {
		set inf ""
	    } else {
		set inf " (closed)"
	    }
	    puts [clock format $h(Vote-By) -gmt 1 \
		    -format "Vote By:&%d %B %Y, %H:%M GMT$inf\\\\"]
	    unset h(Vote-By)
	}

	unset h(TIP) h(Title) h(Author) h(Created)
	unset h(Version) h(Type) h(State) h(Vote)
	# Do any fields I've forgotten!
	foreach {key val} [array get h] {
	    regsub -all -- {-} $key { } key
	    puts [format {%s&%s\\} [quote $key 1] [quote $val 1]]
	}
	puts "\\hline\\end{tabularx}\\end{center}"
	if {$emptyPage} {puts "\\thispagestyle{empty}\\pagestyle{empty}"}
    }

    proc generateDocRefs {{reflevel section}} {
	global PUBLISHURL DOCDIR
	variable citations
	if {[array size citations]} {
	    puts "\\begin{thebibliography}{TIP \\#[array size citations]}"
	    puts "\\addcontentsline{toc}{$reflevel}{References}"
	    foreach cite [lsort -dictionary [array names citations]] {
		array set dtl [getTIPDetails [file join $DOCDIR $cite.tip]]
		puts "\\bibitem\[TIP \\#$cite\]{tip$cite}"
		foreach a $dtl(Author) {
		    regsub {<.*} $a {} a
		    puts "[quote [string trim $a] 1],"
		}
		puts "\\emph{[quote $dtl(Title) 1]},"
		puts "on-line at \\url{$PUBLISHURL/$cite.html}"
		unset dtl
	    }
	    puts "\\end{thebibliography}"
	}
    }

    # The static part of the header, used to define things that would
    # otherwise be extremely backslash-heavy.
    variable tipdefs {
	\urlstyle{sf}
	\setlength{\parskip}{1ex}
	\setlength{\parindent}{0pt}
	\def\tipversion$#1${\texttt{\$#1\$}}
	\def\tiplangle#1{\ensuremath{<}}
	\def\tiprangle#1{\ensuremath{>}}
	\def\tipbar#1{\ensuremath{|}}
	\def\tipmail#1#2{\(\langle\){\small\expandafter\url{#[email protected]#2}}\(\rangle\)}
	\ifx\pdfoutput\undefined
	\newcommand{\tipimage}[2]{%
	    \typeout{Make sure you download #1.eps}\ifthenelse{%
	    \lengthtest{0.8\textwidth>#2}\and\lengthtest{0pt<#2}}{%
	    \includegraphics{#1.eps}}{%
	    \includegraphics[width=0.8\textwidth]{#1.eps}}}
	\newcommand{\tipxref}[1]{}
	\newcommand{\tipxrefend}{}
	\else
	\newcommand{\tipimage}[2]{%
	    \typeout{Make sure you create #1.pdf}\ifthenelse{%
	    \lengthtest{0.8\textwidth>#2}\and\lengthtest{0pt<#2}}{%
	    \includegraphics{#1.pdf}}{%
	    \includegraphics[width=0.8\textwidth]{#1.pdf}}}
	\pdfcatalog{/PageMode /UseOutlines}
	\newcommand{\tipxref}[1]{\pdfannotlink %
	    attr {/C [0.5 0.5 1.0] /Border [0 0 1]} %
	    goto name {#1}}
	\newcommand{\tipxrefend}{\pdfendlink}
	\fi
	\newenvironment{tipabstract}{%
	    \begin{abstract}}{\end{abstract}}
    }

    proc generateLaTeXPreamble {title author {date {}} {class article}} {
	global env
	variable tipdefs
	set ltxopts {}
	set ltxpkg {}
	if {[info exist env(LATEXOPTS)]} {
	    set ltxopts [split $env(LATEXOPTS) ,]
	}
	#set ltxopts [linsert $ltxopts 0 dvips]
	if {[info exist env(LATEXPACKAGES)]} {
	    set ltxpkg [split $env(LATEXPACKAGES) ,]
	}
	set ltxpkg [linsert $ltxpkg 0 \
		amsmath graphicx supertabular hyperref tabularx ifthen]
	puts "\\documentclass\[[join $ltxopts ,]\]{$class}"
	puts "\\usepackage{[join $ltxpkg ,]}"
	puts "\\title{[quote $title 1]}"
	if {[string length $date]} {
	    puts "\\date{[quote $date 1]}"
	}
	puts "\\author{[quote $author 1]}"
	regsub -all "\n\[ \t]+" [string trim $tipdefs] "\n" strippedTD
	regsub -all "%\n" $strippedTD {} strippedTD
	puts $strippedTD
	puts "\\begin{document}\\maketitle"
    }

    proc generateDocument {head body} {
	global FOOTERTEXT
	variable mode one
	array set h $head

	set authors {}
	set sep ""
	foreach a $h(Author) {
	    regsub -all "\[ \t\]*<.*" $a "" a
	    append authors "$sep$a"
	    set sep ", "
	}

	generateLaTeXPreamble "TIP #$h(TIP): $h(Title)" $authors \
		[clock format $h(Created) -gmt 1 -format "%B %d, %Y"]

	generateDocumentHeader h
	puts "\\begin{tipabstract}"
	eval [intuitParagraphKind [lindex $body 1]]
	puts "\\end{tipabstract}"

	puts "\\tableofcontents\\setcounter{page}{0}\\clearpage\\pagestyle{plain}"
	foreach par [lrange $body 2 end] {
	    eval [intuitParagraphKind $par]
	}
	section "Colophon"
	ordinary ''$FOOTERTEXT''
	generateDocRefs
	puts "\\end{document}"
    }

    variable imageURLCache
    array set imageURLCache {}
    proc getImageURLs {tipNumber} {
	global DOCDIR
	variable imageURLCache
	if {[info exist imageURLCache($tipNumber)]} {
	    return $imageURLCache($tipNumber)
	}
	set images {}
	if {$tipNumber == "all"} {
	    foreach tip [getTIPFilenames] {
		array set dtl [getTIPDetails $tip]
		foreach par $dtl(Body) {
		    set cmd [intuitParagraphKind $par]
		    if {[lindex $cmd 0] == "image"} {
			lappend images [lindex $cmd 1]
		    }
		}
	    }
	} else {
	    array set dtl [getTIPDetails [file join $DOCDIR $tipNumber.tip]]
	    foreach par $dtl(Body) {
		set cmd [intuitParagraphKind $par]
		if {[lindex $cmd 0] == "image"} {
		    lappend images [lindex $cmd 1]
		}
	    }
	}
	set imageURLCache($tipNumber) $images
    }
    proc linkEPSImagesForDocument {tipNumber targetDir} {
	foreach url [getImageURLs $tipNumber] {
	    if {
		[regexp {^[-_a-zA-Z0-9]+$} $url] &&
		[file exists [set src [file join $DOCDIR $url.eps]]]
	    }
	    if {![file exists [set dst [file join $targetDir $url.eps]]]} {
		exec ln -s $src $dst
	    }
	}
    }
    proc makePDFImagesForDocument {tipNumber targetDir} {
	set urls [getImageURLs $tipNumber]
	linkEPSImagesForDocument $tipNumber $targetDir
	foreach url $urls {
	    if {
		![regexp {^[-_a-zA-Z0-9]+$} $url] ||
		![file exists [set src [file join $targetDir $url.eps]]]
	    } {
		continue
	    }
	    set dst [file join $targetDir $url.pdf]
	    if {[file exists $dst] && [file mtime $dst]>[file mtime $src]} {
		continue
	    }
	    epstopdf::epstopdf $src $dst
	}
    }

    proc generateWholeArchive {} {
	variable mode all
	variable idxnum
	variable citations
	set tips [getTIPFilenames]
	set t1 [file rootname [file tail [lindex $tips 0]]]
	set tn [file rootname [file tail [lindex $tips end]]]
	generateLaTeXPreamble \
		[format {Tcl Improvement Proposals: TIPs %d--%d} $t1 $tn] \
		{The Tcl Community} {} report
	puts "\\renewcommand{\\bibname}{References}"
	puts "\\renewcommand{\\chaptername}{TIP \\#}"
	puts "\\addtocounter{chapter}{-1}"
	puts "\\tableofcontents\\listoffigures"

	foreach tip $tips {
	    ::puts -nonewline stderr \[
	    set pars [splitIntoParagraphs [getTIPFileContents $tip]]
	    array set h [verifyTIPheader \
		    [splitRFC822Header [lindex $pars 0]]]
	    set kinds {}
	    foreach par [lrange $pars 2 end] {
		lappend kinds [intuitParagraphKind $par]
	    }

	    ::puts -nonewline stderr $h(TIP)
	    puts "\\chapter{[quote $h(Title) 1]}"
	    generateDocumentHeader h 0 tip$h(TIP)
	    puts "\\section{Abstract}"
	    eval [lindex $kinds 0]
	    puts "\\clearpage"
	    unset h
	    foreach par [lrange $kinds 1 end] { eval $par }
	    closecontext
	    ::puts -nonewline stderr "\] "
	}
	::puts stderr ""
	if {[array size citations]} {
	    puts "\\clearpage"
	    set idx [incr idxnum]
	    puts "\\ifx\\pdfoutput\\undefined\\relax\\else\\pdfdest\
		    num $idx xyz\\pdfoutline goto num $idx {References}\\fi"
	    generateDocRefs chapter
	}
	puts "\\end{document}"
    }
}

Added tiptxt.tcl.
























































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
namespace eval tiptxt {
    proc fmtPar {firsthead nexthead body} {
	puts ""
	set str ""
	set body "$firsthead $body"
	# Apply standard transformations here...
	global URLRE TIPURLRE ShortTIPRE BASEURL ISSUEBASE ISSUEURLRE
	regsub -all $TIPURLRE   $body "$BASEURL\\1.txt" body
	regsub -all $ISSUEURLRE $body "$ISSUEBASE\\1" body
	regsub -all $URLRE      $body "<URL:&>" body
	regsub -all {\[\[}      $body \x80 body
	regsub -all {\]\]}      $body \x81 body
	regsub -all $ShortTIPRE $body "\[TIP #\\1\]" body
	regsub -all '''		$body {*} body
	regsub -all ''          $body {/} body
	regsub -all \x80        $body \[ body
	regsub -all \x81        $body \] body
	foreach word [split $body] {
	    if {[string length $str$word] > 72} {
		puts $str
		set str "$nexthead "
	    }
	    append str $word " "
	}
	puts $str
    }

    variable counters {}
    proc manageListCounters {level num} {
	variable counters
	if {
	    [regexp {^1$} $num] &&
	    $level < [llength $counters] &&
	    [lindex $counters $level] != "*"
	} then {
	    set num [lindex $counters $level]
	    incr num
	}
	set counters [lrange [linsert $counters $level $num] 0 $level]
	return [lindex $counters end]
    }
    proc setupIndents {level {msg ""}} {
	format "%*s" [expr {$level>=0?($level+1)*7-1:0}] $msg
    }

    proc bulleting {level body} {
	manageListCounters $level *
	set ind [setupIndents $level]
	regsub {.$} $ind * ind1
	fmtPar $ind1 $ind $body
    }
    proc description {tag level body} {
	set tag " ${tag}:"
	set body [string trim $body]
	manageListCounters $level *
	set ind1 [setupIndents [expr {$level-1}]]
	set ind [setupIndents $level]
	set tagspace [expr {[string length $ind]-[string length $ind1]}]
	if {$tagspace*2 < [string length $tag]} {
	    puts -nonewline \n$ind1$tag
	    fmtPar $ind $ind $body
	} elseif {$tagspace < [string length $tag]} {
	    fmtPar $ind1$tag $ind $body
	} else {
	    fmtPar [format %s%-*s $ind1 $tagspace $tag] $ind $body
	}
    }
    proc enumeration {tag level body} {
	set indt [setupIndents $level [manageListCounters $level $tag].]
	set inds [setupIndents $level]
	fmtPar $indt $inds $body
    }
    proc continuation {level string} {
	set indent [setupIndents [expr {$level-1}]]
	fmtPar $indent $indent $string
    }
    proc ordinary {string} {
	variable counters {}
	continuation -1 $string
    }

    proc section {title {level 1}} {
	variable counters {}
	switch $level {
	    1 {
		regsub -all . $title = uline
		puts "\n [string toupper $title] \n=$uline="
	    }
	    2 {
		regsub -all . $title - uline
		puts "\n [string toupper $title] \n-$uline-"
	    }
	    3 {
		puts "\n [string toupper $title] "
	    }
	    default {
		regsub -all " " $title _ title
		puts "\n_$title_"
	    }
	}
    }
    proc separator {} {
	variable counters {}
	puts -nonewline "\n------------------------------"
	puts "-------------------------------------------"
    }
    proc verbatim {lines} {
	# It's actually quite awkward, since we have to convert tabs to spaces
	puts ""
	foreach line $lines {
	    set bits [split $line \t]
	    set txt [lindex $bits 0]
	    foreach bit [lrange $bits 1 end] {
		append txt " "
		while {[string length $txt] % 8} {append txt " "}
		append txt $bit
	    }
	    puts "   $txt"
	}
    }
    proc centre {lines} {
	puts ""
	set untabbed {}
	set width 0
	foreach line $lines {
	    set bits [split $line \t]
	    set txt [lindex $bits 0]
	    foreach bit [lrange $bits 1 end] {
		append txt " "
		while {[string length $txt] % 8} {append txt " "}
		append txt $bit
	    }
	    lappend untabbed $txt
	    if {[string length $txt]>$width} {set width [string length $txt]}
	}
	if {$width >= 70} {
	    foreach line $untabbed {
		puts $line
	    }
	} else {
	    set ind [expr {(72-$width)/2}]
	    foreach line $untabbed {
		puts [format %*s%s $ind "" $line]
	    }
	}
    }
    proc image {bodytext} {
	variable counters {}
	global ImageRE
	if {
	    [regexp $ImageRE $bodytext -> url caption] &&
	    [regexp {^[-_a-zA-Z0-9]+$} $url]
	} then {
	    global DOCDIR
	    set fn [file join $DOCDIR $url.txt]
	    if {[file isfile $fn] && [file readable $fn]} {
		set f [open $fn r]
		set lines [split [read -nonewline $f] "\n"]
		close $f
		centre $lines
		centre [list $caption]
		return
	    }
	} elseif {[info exist url] && [info exist caption]} {
	    centre [list "<URL:$url>" ]
	    centre [list $caption]
	} else {
	    centre [list "<<$bodytext>>"]
	}
    }
    proc index {kind {errorKind soft}} {
	variable counters {}
	switch $kind {
	    short {
		puts ""
		foreachTIP d {
		    puts -nonewline " TIP #$d(TIP):"
		    switch $d(State) {
			Draft - Rejected {
			    puts -nonewline " ([string index $d(State) 0])"
			}
			default {
			    puts -nonewline "    "
			}
		    }
		    puts " $d(Title)"
		}
	    }
	    medium {
		array set w {1 9 2 4 3 5 4 5}
		foreachTIP d {
		    foreach {name col i} {
			TIP   1 5
			Type  2 0
			State 3 0
			Title 4 0
		    } {
			if {[string length $d($name)] > $w($col)+$i} {
			    set w($col) [expr {[string length $d($name)]+$i}]
			}
		    }
		}
		puts ""
		set format "| %-$w(1)s | %-$w(2)s | %-$w(3)s | %-$w(4)s |"
		set sep [format $format " " " " " " " "]
		regsub -all " " $sep - sep
		regsub -all "\[|\]" $sep + sep
		puts $sep
		puts [format $format "Series ID" "Type" "State" "Title"]
		puts $sep
		foreachTIP d {
		    puts [format $format "TIP #$d(TIP)" \
			    $d(Type) $d(State) $d(Title)]
		}
		puts $sep
	    }
	    long {
		foreachTIP d {
		    puts ""
		    set rows {}
		    lappend rows "TIP #$d(TIP):" $d(Title)
		    lappend rows Version: $d(Version)
		    regsub -all "\t" $d(Author) " " authorNotab
		    if {[llength $d(Author)] == 1} {
			regsub @ [lindex $authorNotab 0] _at_ a
			lappend rows Author: $a
		    } else {
			regsub @ [lindex $authorNotab 0] _at_ a
			lappend rows Authors: $a
			foreach a [lrange $authorNotab 1 end] {
			    regsub @ $a _at_ a
			    lappend rows "" $a
			}
		    }
		    lappend rows  State: $d(State)  Type: $d(Type)
		    if {[info exist d(Tcl-Version)]} {
			lappend rows "Tcl Version:" $d(Tcl-Version)
		    }
		    lappend rows  Vote: $d(Vote)
		    lappend rows  Created: [clock format $d(Created) \
			    -format "%d %b %Y" -gmt 1]
		    set ph "Posting History:"
		    foreach event [split $d(Post-History) ","] {
			lappend rows $ph [string trim $event]
			set ph ""
		    }
		    if {[info exist d(Discussions-To)]} {
			set dt [join [split $d(Discussions-To) ,] ", "]
			regsub -all -- { +} $dt { } dt
			lappend rows "Discussions To:" $dt
		    }
		    if {[info exist d(Obsoletes)]} {
			lappend rows Obsoletes: "TIP #$d(Obsoletes)"
		    }
		    if {[info exist d(Obsoleted-By)]} {
			lappend rows "Obsoleted By:" "TIP #$d(Obsoleted-By)"
		    }
		    if {[info exist d(Vote-By)]} {
			if {$d(Vote-By) > [clock seconds]} {
			    lappend rows  Vote-By: [clock format $d(Vote-By) \
				    -format "%d %b %Y, %H:%M GMT" -gmt 1]
			} else {
			    lappend rows  Vote-By: [clock format $d(Vote-By) \
				    -format "%d %b %Y, %H:%M GMT (closed)" \
				    -gmt 1]
			}
		    }
		    if {[info exist d(Votes-For)]} {
			lappend rows "Votes For:" $d(Votes-For)
		    }
		    if {[info exist d(Votes-Against)]} {
			lappend rows "Votes Against:" $d(Votes-Against)
		    }
		    if {[info exist d(Votes-Abstained)]} {
			lappend rows "Votes Abstained:" $d(Votes-Abstained)
		    }
		    if {[info exist d(Keywords)]} {
			lappend rows Keywords: [join $d(Keywords) ", "]
		    }
		    set width 1
		    foreach {tag ?} $rows {
			if {[string length $tag]>$width} {
			    set width [string length $tag]
			}
		    }
		    foreach {tag val} $rows {
			puts [format "%-*s %s" $width $tag $val]
		    }
		    set indent [format "%*s" $width ""]
		    fmtPar $indent $indent $d(Abstract)
		}
	    }
	    default {
		if {[string compare $errorKind soft]} {
		    return -code error "Index style $kind not supported"
		}
		set msg "*Index style \"$kind\" bit yet supported*"
		regsub -all . $msg * stars
		centre [list $stars $msg $stars]
	    }
	}
    }

    proc generateDocument {head body {extra {}}} {
	global BASEURL
	array set header $head
	section "TIP #$header(TIP): $header(Title)"
	set lines [list Version: $header(Version)]
	set indent 8
	if {[info exist header(Author)]} {
	    set at Author:
	    foreach a $header(Author) {
		regsub @ $a _at_ a
		lappend lines $at $a
		set at ""
	    }
	}
	foreach h {State Type Tcl-Version Vote} {
	    if {[info exist header($h)]} {
		lappend lines ${h}: $header($h)
		if {[string length $h]+1>$indent} {
		    set indent [expr {[string length $h]+1}]
		}
	    }
	}
	lappend lines Created: [clock format $header(Created) \
		-format {%A, %d %B %Y} -gmt 1]
	if {[string compare [lindex $extra 0] URL]} {
	    lappend lines URL: $BASEURL$header(TIP).html
	}
	foreach {key value} $extra {lappend lines ${key}: $value}
	if {[info exist header(Discussions-To)]} {
	    set h Discussions-To:
	    foreach dt [split $header(Discussions-To) ","] {
		lappend lines $h [string trim $dt]
		if {[string length $h]>$indent} {
		    set indent [string length $h]
		}
		set h ""
	    }
	}
	if {[info exist header(Post-History)]} {
	    lappend lines Post-History: $header(Post-History)
	    if {[string length Post-History]+1>$indent} {
		set indent [expr {[string length Post-History]+1}]
	    }
	}
	foreach h {Obsoletes Obsoleted-By} {
	    if {[info exist header($h)]} {
		lappend lines ${h}: "TIP #$header($h)"
		if {[string length $h]+1>$indent} {
		    set indent [expr {[string length $h]+1}]
		}
	    }
	}
	if {[info exist header(Vote-By)]} {
	    lappend lines Vote-By: [clock format $header(Vote-By) -gmt 1 \
		    -format {%A, %d %B %Y, %H:%M GMT}]
	}
	foreach h {Votes-For Votes-Against Votes-Abstained} {
	    if {[info exist header($h)]} {
		lappend lines ${h}: $header($h)
		if {[string length $h]+1>$indent} {
		    set indent [expr {[string length $h]+1}]
		}
	    }
	}
	foreach {key value} $lines {
	    regsub -all "\t" $value " " value
	    puts [format " %-*s %s" $indent $key $value]
	}
	separator
	foreach par $body {
	    eval [intuitParagraphKind $par]
	}
	separator
	global FOOTERTEXT
	ordinary $FOOTERTEXT
    }
}

Added tipview.tcl.












































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
namespace eval tipview {
    proc section {title {level 1}} {
	variable w
	$w insert end $title\n section$level
    }
    proc formattedInsert {string tag} {
	variable w
	regsub -all {'''(('?[^'])+)'''} $string \x81\\1\x81 string
	regsub -all {''(('?[^'])+)''} $string \x80\\1\x80 string
	set idx [$w index end]
	$w insert end $s\n $tag
	while {1} {
	    set idx [$w search -regexp "\x80|\x81" $idx end]
	    if {$idx eq ""} break
	    set c [$w get $idx]
	    set idx2 [$w search -exact $c $idx+1c end]
	    switch [$w get $idx] {
		\x80 {$w tag add ${tag}_i $idx $idx2}
		\x81 {$w tag add ${tag}_b $idx $idx2}
	    }
	    $w delete $idx2
	    $w delete $idx
	}
    }
    proc ordinary {string} {
	formattedInsert $string plain
    }
    proc bulleting {level body} {
	formattedInsert *\t$body list[expr {$level+1}]
    }
    proc description {tag level body} {
	formattedInsert ${tag}:\t$body list[expr {$level+1}]
    }
    proc enumeration {tag level body} {
	formattedInsert $tag.\t$body list[expr {$level+1}]
    }
    proc continuation {level body} {
	formattedInsert $body cont$level
    }
    proc separator {} {
	variable w
	variable sep
	if {![info exist sep]} {
	    set wide [expr {[winfo reqwidth $w]-25}]
	    set sep [::image create photo -width $wide -height 1]
	    $sep put black -to 0 0 $wide 1
	}
	$w image create end -image $sep -padx 5 -pady 5
	$w insert end \n
    }
    proc verbatim {lines} {
	variable w
	$w insert end \n[join $lines \n]\n\n verbatim
    }
    proc index {kind} {
	variable w
	$w insert end "Index $kind not supported by this renderer\n"
    }
    proc image {bodytext} {
	variable w
	if {[regexp {^([^./ ]+) +(.*)} $bodytext -> f caption]} {
	    global DOCDIR
	    set f [file join $DOCDIR $f.gif]
	    if {[file exist $f]} {
		variable img
		if {![info exist img($f)]} {
		    set wide [expr {[winfo reqwidth $w]-25}]
		    set img($f) [::image create photo -file $f]
		    while {[::image width $img($f)] > $wide} {
			set i [::image create photo]
			$i copy $img($f) -subsample 2 2
			::image delete $img($f)
			set img($f) $i
		    }
		}
		$w image create end -image $img($f) -padx 5 -pady 5
		$w insert end \n {} $caption caption \n
		return
	    }
	}
	$w insert end "Image $bodytext not supported by this renderer\n"
    }

    proc generateTIPHeader {hName w} {
	upvar 1 $hName h
	set l $w.top
	set hi [expr {[array size h]-1+[llength $h(Author)]}]
	pack [text $l -height $hi -wrap word -font {Times -14}] \
		-side top -fill x -expand 1
	$l tag configure key -font {Times -14 bold}
	set wide 1
	set font {Times -14 bold}
	foreach n [array names h] {
	    set nw [font measure $font ${n}:]
	    if {$nw>$wide} {set wide $nw}
	}
	incr wide 4
	$l configure -tabs $wide
	$l tag configure head -lmargin1 0 -lmargin2 $wide
	array set done {TIP . Title . Author . Created .}
	$l insert end TIP: {head key} \t$h(TIP)\n head
	$l insert end Title: {head key} \t$h(Title)\n head
	$l insert end Created: {head key} [clock format $h(Created) -gmt 1 \
		-format "\t%A %d %B %Y\n"] head
	$l insert end Authors: {head key} "\t[join $h(Author) \n\t]\n" head
	foreach n [lsort [array names h]] {
	    if {[info exist done($n)]} {continue}
	    $l insert end ${n}: {head key} \t$h($n)\n head
	}
	$l delete end-1c
	$l configure -state disabled
    }
    proc viewTIP {tipnumber} {
	global DOCDIR
	set file  [file join $DOCDIR $tipnumber.tip]
	set data  [getTIPFileContents $file]
	set pars  [splitIntoParagraphs $data]
	set heads [verifyTIPheader [splitRFC822Header [lindex $pars 0]]]
	set par1  [intuitParagraphKind [lindex $pars 1]]
	array set h $heads
	if {[string compare $par1 {section Abstract 1}]} {
	    return -code error "TIP $h(TIP) must start with abstract..."
	}

	set t .t$h(TIP)
	catch {destroy $t}
	toplevel $t
	wm title $t "TIP #$h(TIP): $h(Title)"
	wm iconname $t "TIP #$h(TIP)"

	generateTIPHeader h $t

	variable w $t.bot
	pack [text $w -wrap word] \
		-side top -fill both -expand 1

	$w tag configure section1 -font {Helvetica -18 bold} \
		-lmargin1 1m -rmargin 1m -spacing1 1m -spacing3 1m
	$w tag configure section2 -font {Helvetica -14 bold} \
		-lmargin1 1m -rmargin 1m -spacing1 1m -spacing3 1m
	$w tag configure section3 -font {Helvetica -12 bold} \
		-lmargin1 1m -rmargin 1m -spacing1 1m -spacing3 1m
	$w tag configure verbatim -font {Courier 10}
	$w tag configure plain -font {Times 10} \
		-lmargin1 2m -lmargin2 2m -rmargin 2m -spacing3 1m
	$w tag configure plain_i -font {Times 10 italic}
	$w tag configure plain_b -font {Times 10 bold}
	for {set i 1} {$i<5} {incr i} {
	    $w tag configure list$i -font {Times 10} \
		    -lmargin1 [expr {$i*4+1}]m -lmargin2 [expr {$i*4+5}]m \
		    -rmargin 2m -spacing3 1m -tabs 5m
	    $w tag configure list${i}_i -font {Times 10 italic}
	    $w tag configure list${i}_b -font {Times 10 bold}
	    $w tag configure cont$i -font {Times 10} \
		    -lmargin1 [expr {$i*4+5}]m -lmargin2 [expr {$i*4+5}]m \
		    -rmargin 2m -spacing3 1m
	    $w tag configure cont${i}_i -font {Times 10 italic}
	    $w tag configure cont${i}_b -font {Times 10 bold}
	}

	# generate HTML body
	foreach par [lrange $pars 1 end] {
	    eval [intuitParagraphKind $par]
	}
    }
}

if {![string compare [file join [pwd] $::argv0] [file join [pwd] [info script]]]} {
    # test mode!
    set SRCDIR [file dirname [file join [pwd] [info script]]]
    source $SRCDIR/config.tcl
    source $SRCDIR/parse.tcl

    package require Tk
    pack [listbox .l -width 5 -yscroll {.s set}] \
	    [scrollbar .s -orient vertical -command {.l yview}] \
	    -side left -expand 1 -fill both
    foreachTIP t {
	.l insert end $t(TIP)
    }
    bind .l <Double-1> {tipview::viewTIP [.l get @%x,%y]}
}

Added tipxml.tcl.


















































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
source $SRCDIR/base64.tcl
namespace eval tipxml {
    variable section
    variable sectype
    variable secnum -1
    variable title
    array set section {}
    array set sectype {}
    array set title {}

    proc makePCDATA {string} {
	regsub -all &    $string {\&amp;}  string
	regsub -all <    $string {\&lt;}   string
	regsub -all >    $string {\&gt;}   string
	regsub -all '    $string {\&apos;} string
	regsub -all \"   $string {\&quot;} string
	return $string
    }
    proc makeCDATAQ {string} {
	# Ho hum, this does the right thing according to the Standard...
	return [makePCDATA $string]
	#regsub -all \" $string {\\&} string
	#return $string
    }

    proc makeTextContent {string} {
	global URLRE EmailRE ShortTIPRE TIPURLRE ISSUEBASE ISSUEURLRE
	set q \x82
	regsub -all $EmailRE $string "<mailto:\\1>" string
	regsub -all $ISSUEURLRE $string "$ISSUEBASE\\1" string
	regsub -all $URLRE $string "\x80url ref=${q}&${q}/\x81" string
	regsub -all {\[\[} $string \x83 string
	regsub -all {\]\]} $string \x84 string
	regsub -all "\\\[\x80url (\[^\x81\]\x81)\\\]" $string \
		"\x80url style=${q}compact${q} \\1" string
	regsub -all {'''(('?[^'])+)'''} $string \
		"\x85\200emph style=${q}bold${q}\x81\\1\x80/emph\x81" string
	regsub -all {''(('?[^'\x85])+)''} $string \
		"\200emph style=${q}italic${q}\x81\\1\x80/emph\x81" string
	regsub -all $TIPURLRE $string \
		"\x80tipref type=${q}url${q} tip=${q}\\1${q}/\x81" string
	regsub -all $ShortTIPRE $string \
		"\x80tipref type=${q}text${q} tip=${q}\\1${q}/\x81" string
	regsub -all &  $string {\&amp;}  string
	regsub -all <  $string {\&lt;}   string
	regsub -all >  $string {\&gt;}   string
	regsub -all \" $string {\&quot;} string
	regsub -all '  $string {\&apos;} string
	regsub -all \x80 $string <  string
	regsub -all \x81 $string >  string
	regsub -all \x82 $string \" string
	regsub -all \x83 $string \[ string
	regsub -all \x84 $string \] string
	regsub -all \x85 $string {} string
	return $string
    }

    variable curlev -1
    variable contexts {}
    variable ctext
    array set ctext {}
    variable encounter
    array set encounter {}
    proc enterlistcontext {level good bad1 bad2} {
	variable curlev
	variable contexts
	variable ctext
	variable encounter
	set result 0
	if {$level > $curlev} {
	    incr curlev
	    lappend contexts "</$good>"
	    set ctext($curlev) "<$good>"
	    set encounter($curlev) 0
	    set result 1
	}
	switch [lindex $contexts end] "</$bad1>" - "</$bad2>" {
	    set close [lindex $contexts end]
	    set closei [format "</item.%s>" [string index $close 2]]
	    append ctext($curlev) $closei $close < $good >
	    set encounter($curlev) 0
	    set contexts [lreplace $contexts end end "</$good>"]
	    set result 1
	}
	return $result
    }
    proc closecontext {{level -1}} {
	variable curlev
	variable contexts
	variable ctext
	variable encounter
	while {$level < $curlev} {
	    set txt $ctext($curlev)
	    unset ctext($curlev) encounter($curlev)
	    set close [lindex $contexts end]
	    set closei [format "</item.%s>" [string index $close 2]]
	    if {[incr curlev -1] >= 0} {
		append ctext($curlev) $txt $closei $close
		set contexts [lrange $contexts 0 \
			[expr {[llength $contexts]-2}]]
	    } else {
		variable section
		variable secnum
		lappend section($secnum) "$txt$closei$close"
		set contexts [list]
		return
	    }
	}
    }

    proc continuation {level body} {
	variable curlev
	variable ctext
	variable section
	variable secnum

	if {$curlev == -1} {
	    lappend section($secnum) "<quote>[makeTextContent $body]</quote>"
	    return
	}
	closecontext $level
	append ctext($curlev) "<para>" [makeTextContent $body] "</para>"
    }
    proc bulleting {level body} {
	closecontext $level
	set flag [enterlistcontext $level   itemize   enumerate describe]
	variable curlev
	variable ctext
	if {!$flag} {
	    append ctext($curlev) "</item.i>"
	}
	append ctext($curlev) "<item.i>"
	continuation $level $body
    }
    proc enumeration {tag level body} {
	closecontext $level
	set flag [enterlistcontext $level   enumerate   itemize describe]
	variable curlev
	variable ctext
	variable encounter
	if {!$flag} {
	    append ctext($curlev) "</item.e>"
	}
	if {$tag == 1} {
	    set tag [incr encounter($curlev)]
	} else {
	    set encounter($curlev) $tag
	}
	append ctext($curlev) "<item.e index='" $tag "'>"
	continuation $level $body
    }
    proc description {tag level body} {
	closecontext $level
	set flag [enterlistcontext $level   describe   enumerate itemize]
	variable curlev
	variable ctext
	if {!$flag} {
	    append ctext($curlev) "</item.d>"
	}
	append ctext($curlev) "<item.d name='" [makeCDATAQ $tag] "'>"
	continuation $level $body
    }
    proc verbatim {lines} {
	variable curlev
	set l {}
	foreach line $lines {
	    append l "<vline encoding='base64'>" [B64encode $line] "</vline>"
	}
	if {$curlev >= 0} {
	    variable ctext
	    append ctext($curlev) "<verbatim>" $l "</verbatim>"
	} else {
	    variable section
	    variable secnum
	    lappend section($secnum) "<verbatim>$l</verbatim>"
	}
    }

    ### FIXME!  THIS IS *COMPLETELY* WRONG! ###
    proc section {secttitle {level 1}} {
	closecontext
	variable section
	variable secnum
	variable sectype
	variable title
	set n [incr secnum]
	set title($n) $secttitle
	set section($n) {}
	set sectype($n) $level
    }
    proc image {bodytext} {
	global ImageRE
	closecontext
	variable section
	variable secnum
	set caption {}
	regexp $ImageRE [string trim $bodytext] -> url caption
	set caption [string trim $caption]
	if {[string length $caption]} {
	    lappend section($secnum) \
		    "<image src=\"$url\" caption=\"$caption\" />"
	} else {
	    lappend section($secnum) "<image src=\"$url\" />"
	}
    }
    proc index {kind} {
	closecontext
	variable section
	variable secnum
	lappend section($secnum) "<index kind='$kind'><?tipindex kind='$kind'?></index>"
    }
    proc separator {} {
	closecontext
	variable section
	variable secnum
	lappend section($secnum) "<rule/>"
    }
    proc ordinary {string} {
	closecontext
	variable section
	variable secnum
	lappend section($secnum) "<para>[makeTextContent $string]</para>"
    }
    proc stag {level} {
	return [lindex {"" "" sub subsub} $level]section
    }
    proc generateDocument {head body} {
	global AuthorRE BASEURL FOOTERTEXT
	array set h $head
	puts "<?xml version=\"1.0\" encoding=\"ISO-8859-1\" ?>"
	puts "<!DOCTYPE TIP SYSTEM \"${BASEURL}tipxml.dtd\">"
	puts "<!-- Converted at [clock format [clock seconds] -gmt 1] -->"
	puts "<!-- $FOOTERTEXT -->\n\n<TIP number='$h(TIP)'>"
	puts -nonewline "<header><title>[makePCDATA $h(Title)]</title>"
	foreach a $h(Author) {
	    regexp $AuthorRE $a -> name addr
	    set name [makePCDATA [string trim $name]]
	    set addr [makeCDATAQ mailto:$addr]
	    puts -nonewline "<author address=\"$addr\">$name</author>"
	}
	puts -nonewline "<status type='[string tolower $h(Type)]'"
	puts -nonewline " state='[string tolower $h(State)]'"
	if {[info exist h(Tcl-Version)]} {
	    puts -nonewline " tclversion=\"$h(Tcl-Version)\""
	}
	switch $h(Vote) {
	    Pending       {puts -nonewline " vote='prior'"}
	    "In progress" {puts -nonewline " vote='during'"}
	    Done          {puts -nonewline " vote='after'"}
	    "No voting"   {puts -nonewline " vote='none'"}
	}
	puts -nonewline ">[makePCDATA $h(Version)]</status>"
	puts -nonewline "<history>"
	foreach e $h(Post-History) {
	    puts -nonewline "<event>[makePCDATA $e]</event>"
	}
	puts -nonewline "</history>"
	eval [clock format $h(Created) -gmt 1 -format {puts -nonewline \
		"<created day='[string trimleft %d 0]'\
		month='[string tolower %b]' year='%Y' />"}]
	if {[info exist h(Discussions-To)]} {
	    foreach dt [split $h(Discussions-To) ,] {
		puts -nonewline \
			"<discussions url='[makeCDATAQ [string trim $dt]]'/>"
	    }
	}
	if {[info exist h(Keywords)]} {
	    foreach k [split $h(Keywords) ,] {
		puts -nonewline \
			"<keyword>[makePCDATA [string trim $k]]</keyword>"
	    }
	}
	if {[info exist h(Obsoletes)]} {
	    puts -nonewline "<obsoletes tip='$h(Obsoletes)'/>"
	}
	if {[info exist h(Obsoleted-By)]} {
	    puts -nonewline "<obsoleted tip='$h(Obsoleted-By)'/>"
	}
	if {
	    [info exist h(Vote-By)] || [info exist h(Votes-For)] ||
	    [info exist h(Votes-Against)] || [info exist h(Votes-Abstained)]
	} then {
	    if {[info exist h(Vote-By)]} {
		puts -nonewline "<voting closes='$h(Vote-By)'>"
	    } else {
		puts -nonewline "<voting>"
	    }
	    if {[info exist h(Votes-For)]} {
		puts -nonewline "<for votes='"
		puts -nonewline [join [split $h(Votes-For) ", "]]
		puts -nonewline "'/>"
	    }
	    if {[info exist h(Votes-Against)]} {
		puts -nonewline "<against votes='"
		puts -nonewline [join [split $h(Votes-Against) ", "]]
		puts -nonewline "'/>"
	    }
	    if {[info exist h(Votes-Abstained)]} {
		puts -nonewline "<abstained votes='"
		puts -nonewline [join [split $h(Votes-Abstained) ", "]]
		puts -nonewline "'/>"
	    }
	    puts -nonewline "</voting>"
	}
	puts "</header>"
	set abstractCmd [intuitParagraphKind [lindex $body 1]]
	puts "<abstract>[makeTextContent [lindex $abstractCmd 1]]</abstract>"
	puts -nonewline "<body>"

	# Parse the paragraphs
	foreach par [lrange $body 2 end] {eval [intuitParagraphKind $par]}
	closecontext
	# Now need to output the sections...
	variable section
	variable sectype
	variable title
	set level 0
	for {set i 0} {$i<[array size section]} {incr i} {
	    set l $sectype($i)
	    if {!$level} {
		if {$l != 1} {
		    error "must have section before sub(sub)section"
		}
	    } else {
		if {$l-$level == 2} {
		    error "cannot generate a subsubsection in a section\
			    without an intervening subsection"
		}
		while {$level>=$l} {
		    puts "</[stag $level]>"
		    incr level -1
		}
	    }
	    puts "<[stag $l] title=\"[makeCDATAQ $title($i)]\">"
	    puts [join $section($i) "\n"]
	    set level $l
	}
	while {$level>0} {
	    puts "</[stag $level]>"
	    incr level -1
	}

	puts "</body></TIP>"
    }
}