COMPILATION LISTING OF SEGMENT xforum_status_
Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992
Compiled at: CGI
Compiled on: 2000-04-18_1128.72_Tue_mdt
Options: optimize map
1 /****^ ***********************************************************
2* * *
3* * Copyright, (C) Honeywell Bull Inc., 1988 *
4* * *
5* * Copyright, (C) Honeywell Information Systems Inc., 1983 *
6* * *
7* *********************************************************** */
8
9
10
11 /****^ HISTORY COMMENTS:
12* 1) change(85-01-25,Davids), approve(86-02-04,MCR7350),
13* audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
14* Changed the truncation string from " ..." to "....". This was
15* done to make very appearent that numbers truncated in the middle
16* are not shorter numbers. Also changed the values of new_field_len
17* from a constant 12 if the input value is not "" to its actual
18* length + 2. Did the same for total_field_len except the constant
19* there was 20. The +2 is to separate the new and total fields from
20* the banner field.
21*
22* 85-02-21 Davids: Added code in the update_current entry that
23* checks the input str for a new_line character. If one exists it
24* uses only the characters to the left of it. The "..." string is
25* appended onto the truncated string to show that something is
26* missing. This was needed so that multi-line subjects could be at
27* least partially displayed. It was decided to truncate instead of
28* translating the new line into some other character becuase it was
29* felt that the new line represented a logical break point (why else
30* have it).
31* 2) change(88-01-19,LJAdams), approve(88-02-09,MCR7838),
32* audit(88-02-19,Blair), install(88-02-24,MR12.2-1027):
33* Changed all field lengths from 80 to 132 in order to accomodate 132
34* character terminals.
35* END HISTORY COMMENTS */
36
37
38 xforum_status_:
39
40 /*
41* BEGIN DESCRIPTION
42*
43* function:
44* This module is used to manage the contents of the status window and the
45* help line window. The status window is a 2 line line window above the
46* menu window. The first line is named the title line while the second line
47* is the data line. The help_line window is a 1 line window below user_io.
48* In this module it is called the usage_line. These lines are images of the
49* screen output.
50*
51* description of entry points:
52* initialize: This entry sets the values of some internal static variables
53* that are used by the rest of the entries.
54*
55* update_total: This entry is used to set the total field in the data_line.
56* The new total is input as a string which contains the characters
57* "total:". The internal proc UPDATE is used to position the new string on
58* the data_line. It is positioned to start in column 1 and will be
59* truncated if longer than 20 characters.
60*
61* update_new: This entry is used to set the new field in the data line.
62* The new new is input as a string which contains the characters "new:".
63* The internal proc UPDATE is used to position the new string on the
64* data_line. If the new string can fit on the data_line in the space
65* left by the total string then the RIGHT_JUSTIFY procedure is called to
66* create a new string with enough padding on the left to result in a right
67* justified new string. The UPDATE procedure is then called to place the
68* new string on the data line.
69*
70* update_banner: This entry is used to place a banner on the data_line.
71* If the banner if shorter than the data_line a call to CENTER is made to
72* create a new string with enough spaces on the left to cause the banner
73* to be centered. A call is then made to UPDATE to position the banner on
74* the data_line starting in column 1.
75*
76* update_current: This entry is used to place the current meeting index
77* on the data line. The current data must fit in the space left over
78* from 2 * the space used in the total field or the new field, which ever
79* is bigger. This has the effect of centering the current data on the data
80* line. A call to RAW_UPDATE is made to place spaces between the total and
81* new fields - erasing what was there. Calls are then made to CENTER and
82* UPDATE to center the current data within the space determined from the
83* calcuation described abive, and place the data on the data line.
84*
85* update_title: This entry is used to place a title on the title line.
86* A space is added to each end of the title and CENTER is called to center
87* the title plus spaces on the line. The dash (-) character is used as a
88* pad character instead of spaces. A call to UPDATE is then made to
89* position title plus spaces plus dashes on the line.
90*
91* redisplay: This entry is used to cause the text stored in the title, data
92* and help lines to be output to the screen. The window_display_ entry is
93* used. This entry matches the current text of the windows and changes only
94* those characters that need to be changed. window_sync_ calls follow the
95* window_display_ calls to force the display instead of waiting for a full
96* buffer.
97*
98* description of internal procedures:
99* CENTER: Given a string, and a length this internal procedure pads the
100* input string on the left with enough spaces to cause the string to be
101* centered in a string of the given length. This padded string is then
102* returned. If the string is greater than the length, it is truncated to
103* the input length.
104*
105* RIGHT_JUSTIFY: Given a string, and a length this internal procedure pads
106* the input string on the left with enough spaces to cause the string to be
107* right justified in a string of the given length. This padded string is
108* then returned. If the string is greater than the length, it is truncated
109* to the input length.
110*
111* UPDATE: This internal procedure inserts a given string into one of the
112* "lines" (title, data). The string is constrained to start at a
113* given column and be no more than a given length. If the string length
114* is less than the given length the string is just inserted into the line
115* via a call to RAW_UPDATE. If the string length is greater than the given
116* length and greater than 4 than the first characters of
117* the string are inserted into the line. These characters are followed by
118* " ...". If the string length is less than of equal to 4 but the input
119* length is even less then the first characters of the
120* string are placed in the line.
121*
122* RAW_UPDATE: This internal procedure inserts the given string into another
123* given string. The string is inserted starting at a given column.
124*
125* known bugs:
126*
127* notes:
128*
129* history
130* 84-01-?? Deryk Barker: Procedure for handling xforum's status window.
131* Some ideas borrowed from xmail's equivalent.
132*
133* 84-05-03 Davids: Modified so that the status message does not share the
134* line with the number of new transactions and the total number of
135* transaction. The new and total numbers now share the line with current
136* transaction numbers.
137*
138* 84-07-06 Davids: Added the update_title entry. This will be used to put
139* the menu title, including meeting name, into the status line so it can be
140* removed from the menu. This will allow the menu title to be displayed
141* even if the process is performing local menu display.
142*
143* 84-07-24 Davids: Created 3 separate variables to hold the data, title,
144* and usage lines. This allowed easy spliting of the usage line (help line
145* window) from the data and title (status window).
146*
147* 84-07-25 Davids: Added the redisplay_usage entry so that the only the
148* usage message can be redisplayed. This is needed for Multics mode.
149*
150* 84-07-27 Davids: Added calls to window_$sync to the redisplay and
151* redisplay_usage entry points.
152*
153* 84-07-31 Davids: Removed call to CENTER from update_usage entry. This has
154* the effect of left justifying the usage message. Added code in
155* update_title to bracket title with spaces before the pad characters are
156* added.
157*
158* 84-08-02 Davids: Added the update_help_line, push_help_line, and
159* pop_help_line entry points. This was done so that the help line could be
160* updated from within emacs.
161*
162* 84-09-28 Davids: Deleted the entries redisplay_usage, update_usage,
163* update_help_line, push_help_line, and pop_help_line. Modified the
164* redisplay entry so that it redisplays the help line by calling
165* xforum_help_line$redisplay.
166*
167* 84-10-03 Davids: Changed the new field length from 9 to 12 to accommodate
168* the larger text string "Unseen:".
169*
170* 84-11-06 Davids: Changed references to xforum_help_line to
171* xforum_help_line_.
172*
173* 84-11-13 Davids: Auditing changes: 1) Moved returns that occured inside
174* the begin blocks of the update_new, banner, current, and title entries
175* to outside the begin blocks. 2) Changed the initialization of the
176* window_image arrau from string (window_image) = "" to just
177* window_image = "". 3) Replaced the substr of SPACES to get a string of
178* spaces to a reference to copy (in update_current). Other changes:
179* Reorganized the declarations.
180* END DESCRIPTION
181**/
182
183 initialize:
184 proc ();
185
186 /* PARAMETERS */
187
188 /* EXTERNAL STATIC */
189
190 /* ENTRIES */
191
192 dcl window_display_ entry (ptr, (*) char (*), fixed bin (35));
193 dcl xforum_help_line_$redisplay entry options (variable);
194
195 /* CONDITIONS */
196
197 /* INTERNAL AUTOMATIC */
198
199 dcl used_cols fixed bin;
200 dcl window_image_ptr ptr init (addr (static_window_image));
201
202
203 /* INTERNAL STATIC */
204
205 dcl (
206 banner_field_len fixed bin,
207 current_field_len fixed bin,
208 data_line char (132) init (""),
209 new_field_len fixed bin,
210 status_window (2) char (132) init ("", ""),
211 static_window_image (2) char (132) unal init ("", ""),
212 title_field_len fixed bin,
213 title_line char (132) init (""),
214 total_field_len fixed bin,
215 window_image_width fixed bin init (79)
216 ) internal static;
217
218 /* CONSTANTS */
219
220
221 dcl xs_NL char (1) init ("
222 ") internal static options (constant);
223
224
225 /* BUILTINS */
226
227 dcl (
228 addr,
229 char,
230 copy,
231 divide,
232 index,
233 length,
234 ltrim,
235 max,
236 min,
237 mod,
238 rtrim,
239 substr
240 ) builtin;
241
242 /* BASED */
243
244 dcl window_image (2) char (window_image_width) based (window_image_ptr);
245
246 /* INCLUDE FILES */
247
1 1 /* START OF: xforum_windows.incl.pl1 * * * * * */
1 2
1 3 /* structures for windows used by xforum - Deryk Barker January 1984 */
1 4
1 5 dcl 1 xforum_windows aligned external static,
1 6 2 (status, menu, bottom, orig_user_io, help_line) aligned like xforum_window_info;
1 7
1 8 dcl 1 xforum_window_info,
1 9 2 iocb ptr,
1 10 2 position aligned like window_position_info;
1 11
2 1 /* BEGIN INCLUDE FILE ... window_control_info.incl.pl1 JRD */
2 2 /* format: style3 */
2 3
2 4 /* Modified 26 January 1982 by William York to add the set_more_handler
2 5* and reset_more_handler control orders. */
2 6 /* Modified October 1982 by WMY to add set and get_token_characters,
2 7* set and get_more_prompt. */
2 8 /* Modified February 1983 by WMY to add the line_editor_key_binding_info
2 9* structure. */
2 10 /* Modified 30 September 1983 by Jon A. Rochlis to add the origin.column for
2 11* partial screen width windows. */
2 12 /* Modified 9 October 1983 by JR to add version 1 window_edit_line_info.
2 13* This should be removed when window_info.incl.pl1 is created. */
2 14 /* Modified 29 February 1984 by Barmar to add version 1
2 15* get_editor_key_bindings_info. */
2 16 /* Modified 1 March 1984 by Barmar to add version 1
2 17* set_editor_key_bindings_info. */
2 18 /* Modified 2 March 1984 by Barmar to upgrade to version 3
2 19* line_editor_key_bindings_info, which includes the name, description, and
2 20* info path */
2 21
2 22 /* structure for the set_window_info and get_window_info
2 23* control orders. */
2 24
2 25 dcl 1 window_position_info
2 26 based (window_position_info_ptr),
2 27 2 version fixed bin,
2 28 2 origin,
2 29 3 column fixed bin,
2 30 3 line fixed bin,
2 31 2 extent,
2 32 3 width fixed bin,
2 33 3 height fixed bin;
2 34
2 35 dcl (window_position_info_version, window_position_info_version_1)
2 36 fixed bin internal static init (1) options (constant);
2 37 dcl window_position_info_ptr
2 38 pointer;
2 39
2 40 /* structure for the set_window_status and get_window_status
2 41* control orders */
2 42
2 43 declare window_status_info_ptr
2 44 pointer;
2 45 declare 1 window_status_info
2 46 aligned based (window_status_info_ptr),
2 47 2 version fixed bin,
2 48 2 status_string bit (36) aligned; /* string (window_status) */
2 49 /* see window_status.incl.pl1 for the contents of this string */
2 50
2 51
2 52 declare (window_status_version, window_status_version_1)
2 53 fixed bin internal static init (1) options (constant);
2 54
2 55 /* info structure for the set_more_responses and get_more_responses control
2 56* orders */
2 57
2 58
2 59 dcl 1 more_responses_info
2 60 aligned based (more_responses_info_ptr),
2 61 2 version fixed bin,
2 62 2 n_yeses fixed bin, /* how many valid characters in the strings below */
2 63 2 n_noes fixed bin,
2 64 2 yeses char (32) unaligned,
2 65 2 noes char (32) unaligned;
2 66
2 67 dcl (more_responses_info_version_1, more_responses_version)
2 68 fixed bin internal static init (1) options (constant);
2 69 dcl more_responses_info_ptr
2 70 pointer;
2 71
2 72 /* structure for the set_break_table and get_break_table
2 73* control orders */
2 74
2 75 declare break_table_ptr pointer;
2 76 declare 1 break_table_info aligned based (break_table_ptr),
2 77 2 version fixed bin,
2 78 2 breaks (0:127) bit (1) unaligned;
2 79
2 80 declare (break_table_info_version, break_table_info_version_1)
2 81 fixed bin init (1) internal static options (constant);
2 82
2 83 declare 1 more_handler_info aligned based (more_handler_info_ptr),
2 84 2 version fixed bin,
2 85 2 flags unaligned,
2 86 3 old_handler_valid
2 87 bit(1),
2 88 3 pad bit(35),
2 89 2 more_handler entry (pointer, bit(1) aligned),
2 90 2 old_more_handler entry (pointer, bit(1) aligned);
2 91
2 92 declare more_handler_info_ptr pointer;
2 93
2 94 declare (more_handler_info_version, more_handler_info_version_3)
2 95 fixed bin internal static options (constant) init (3);
2 96
2 97 declare 1 token_characters_info aligned based (token_characters_info_ptr),
2 98 2 version char(8),
2 99 2 token_character_count
2 100 fixed bin,
2 101 2 token_characters
2 102 char (128) unaligned;
2 103
2 104 declare token_characters_info_ptr pointer;
2 105
2 106 declare token_characters_info_version_1 char(8) internal static options (constant) init ("wtci0001");
2 107
2 108 declare 1 more_prompt_info aligned based (more_prompt_info_ptr),
2 109 2 version char(8),
2 110 2 more_prompt char(80);
2 111
2 112 declare more_prompt_info_ptr pointer;
2 113
2 114 declare more_prompt_info_version_1 char(8) static options (constant) init ("wsmp0001");
2 115
2 116 /* Line editor stuff ... */
2 117
2 118 dcl line_editor_key_binding_info_ptr
2 119 pointer;
2 120
2 121 dcl line_editor_binding_count
2 122 fixed bin;
2 123 dcl line_editor_longest_sequence
2 124 fixed bin;
2 125 /* For each binding, action defines what to do for that sequence. Constants
2 126* are defined in window_editor_values.incl.pl1. Only if action is set to
2 127* EXTERNAL_ROUTINE does the editor_routine entry variable get examined. */
2 128
2 129 dcl 1 line_editor_key_binding_info
2 130 aligned based (line_editor_key_binding_info_ptr),
2 131 2 version char(8),
2 132 2 binding_count fixed bin,
2 133 2 longest_sequence fixed bin,
2 134 2 bindings (line_editor_binding_count refer
2 135 (line_editor_key_binding_info.binding_count)),
2 136 3 sequence char(line_editor_longest_sequence refer
2 137 (line_editor_key_binding_info.longest_sequence)) varying,
2 138 3 action fixed bin,
2 139 3 numarg_action fixed binary,
2 140 3 editor_routine entry (pointer, fixed bin(35)),
2 141 3 name char (64) varying unaligned,
2 142 3 description char (256) varying unaligned,
2 143 3 info_path unaligned,
2 144 4 info_dir char (168),
2 145 4 info_entry char (32);
2 146
2 147
2 148 dcl line_editor_key_binding_info_version_3
2 149 char(8) static options (constant) init ("lekbi003");
2 150
2 151 dcl 1 get_editor_key_bindings_info aligned based (get_editor_key_bindings_info_ptr),
2 152 2 version char (8),
2 153 2 flags,
2 154 3 entire_state bit (1) unaligned,
2 155 3 mbz bit (35) unaligned,
2 156 2 key_binding_info_ptr ptr,
2 157 2 entire_state_ptr ptr;
2 158
2 159 dcl get_editor_key_bindings_info_ptr ptr;
2 160 dcl get_editor_key_bindings_info_version_1 char (8) int static options (constant) init ("gekbi_01");
2 161
2 162 dcl 1 set_editor_key_bindings_info aligned
2 163 based (set_editor_key_bindings_info_ptr),
2 164 2 version char (8),
2 165 2 flags,
2 166 3 replace bit (1) unaligned,
2 167 3 update bit (1) unaligned,
2 168 3 mbz bit (34) unaligned,
2 169 2 key_binding_info_ptr ptr;
2 170
2 171 dcl set_editor_key_bindings_info_ptr ptr;
2 172 dcl set_editor_key_bindings_info_version_1 char (8) int static options (constant) init ("sekbi_01");
2 173
2 174 /* This should be moved to window_info.incl.pl1 when that include file is
2 175* created. JR 2/1/84 */
2 176
2 177 dcl 1 window_edit_line_info
2 178 based (window_edit_line_info_ptr),
2 179 2 version char (8),
2 180 2 line_ptr ptr,
2 181 2 line_length fixed bin (21); /* later we will hack initial cursor position, key bindings, etc. */
2 182
2 183 dcl window_edit_line_info_version_1
2 184 char (8) static options (constant) init ("wedl0001");
2 185
2 186 dcl window_edit_line_info_ptr
2 187 ptr;
2 188
2 189 /* END INCLUDE FILE window_control_info.incl.pl1 */
1 12
1 13
1 14 /* END OF: xforum_windows.incl.pl1 * * * * * */
248
249
3 1 /* begin include fine window_dcls.incl.pl1 BIM June 1981 */
3 2 /* Modified 9 October 1983 by Jon A. Rochlis to add window_$edit_line. */
3 3
3 4 /* format: style3 */
3 5
3 6 declare window_$bell entry (pointer, fixed binary (35));
3 7 declare window_$clear_region
3 8 entry (pointer, fixed binary, fixed binary, fixed binary, fixed binary, fixed binary (35));
3 9 declare window_$clear_to_end_of_line
3 10 entry (pointer, fixed binary (35));
3 11 declare window_$clear_to_end_of_window
3 12 entry (pointer, fixed binary (35));
3 13 declare window_$clear_window
3 14 entry (pointer, fixed binary (35));
3 15 declare window_$delete_chars
3 16 entry (pointer, fixed binary, fixed binary (35));
3 17 declare window_$get_cursor_position
3 18 entry (pointer, fixed binary, fixed binary, fixed binary (35));
3 19
3 20 /* Call window_$get_echoed_chars (iocb_ptr, n_to_read, read_buffer, n_read, read_break, code); */
3 21
3 22 declare window_$get_echoed_chars
3 23 entry (pointer, fixed binary (21), character (*), fixed binary (21), character (1) var,
3 24 fixed binary (35));
3 25 declare window_$get_unechoed_chars
3 26 entry (pointer, fixed binary (21), character (*), fixed binary (21), character (1) var,
3 27 fixed binary (35));
3 28 declare window_$insert_text entry (pointer, character (*), fixed binary (35));
3 29 declare window_$overwrite_text
3 30 entry (pointer, character (*), fixed binary (35));
3 31 declare window_$position_cursor
3 32 entry (pointer, fixed binary, fixed binary, fixed binary (35));
3 33
3 34 /* Call window_$position_cursor_rel (iocb_ptr, delta_line, delta_column, code); */
3 35
3 36 declare window_$position_cursor_rel
3 37 entry (pointer, fixed binary, fixed binary, fixed binary (35));
3 38
3 39 /* Call window_$scroll_region (iocb_ptr, first_line_of_region, n_lines_of_region, distance_to_scroll_region_negative_is_up,
3 40* code); */
3 41
3 42 declare window_$scroll_region
3 43 entry (pointer, fixed binary, fixed binary, fixed binary, fixed binary (35));
3 44 declare window_$sync entry (pointer, fixed binary (35));
3 45
3 46 /* Call window_$write_raw_text (iocb_ptr, text_string, code); */
3 47
3 48 declare window_$write_raw_text
3 49 entry (pointer, character (*), fixed binary (35));
3 50
3 51 /* Call window_$write_sync_read (iocb_ptr, prompt_string, n_to_read, read_buffer, n_read, break_char, code); */
3 52
3 53 declare window_$write_sync_read
3 54 entry (pointer, character (*), fixed bin (21), character (*), fixed binary (21),
3 55 character (1) var, fixed binary (35));
3 56
3 57 /* Call window_$change_line (iocb_ptr, new_line, code); */
3 58
3 59 declare window_$change_line entry (pointer, fixed binary, fixed binary (35));
3 60
3 61 /* Call window_$change_column (iocb_ptr, new_column, code); */
3 62
3 63 declare window_$change_column
3 64 entry (pointer, fixed binary, fixed binary (35));
3 65
3 66 /* Call window_$get_one_unechoed (iocb_ptr, char_or_len_0, block_flag, code); */
3 67 declare (
3 68 window_$get_one_unechoed,
3 69 window_$get_one_unechoed_char
3 70 ) entry (pointer, character (1) var, bit (1) aligned, fixed binary (35));
3 71
3 72 declare window_$create entry (pointer, pointer, pointer, fixed binary (35));
3 73
3 74 declare window_$destroy entry (pointer, fixed binary (35));
3 75
3 76 declare window_$edit_line entry (pointer, pointer, pointer, fixed bin(21), fixed bin(21), fixed bin(35));
3 77
3 78 /* call window_$edit_line (iocb_ptr, window_edit_line_info_ptr, buffer_ptr,
3 79* buffer_len, n_returned, code); */
3 80
3 81
3 82 /* end include file window_dcls.incl.pl1 */
250
251
252 window_image_width =
253 min (length (static_window_image (1)), xforum_windows.status.width);
254 window_image = "";
255
256 total_field_len, new_field_len = 0;
257
258 title_field_len = window_image_width;
259
260 banner_field_len, current_field_len =
261 window_image_width - (total_field_len + new_field_len);
262
263 return;
264
265 update_total:
266 entry (str);
267
268 dcl str char (*);
269
270 if str ^= ""
271 then total_field_len = length (rtrim (str)) + 2; /* 2 space separator */
272
273 call UPDATE (addr (data_line), 1, total_field_len, str);
274
275 if str = ""
276 then total_field_len = 0;
277
278 return;
279
280 update_new:
281 entry (str);
282
283 if str ^= ""
284 then new_field_len = length (rtrim (str)) + 2; /* 2 space separator */
285
286 begin;
287
288 dcl field char (new_field_len);
289 dcl trimmed_value char (length (str)) var;
290 dcl trimmed_len fixed bin;
291 dcl starting_col fixed bin;
292
293 starting_col = window_image_width - new_field_len + 1;
294
295 trimmed_value = ltrim (rtrim (str));
296
297 trimmed_len = length (trimmed_value);
298
299 if trimmed_len < new_field_len then do;
300 call RIGHT_JUSTIFY ((trimmed_value), field);
301 call UPDATE (addr (data_line), starting_col, new_field_len, field);
302 end;
303 else call UPDATE (addr (data_line), starting_col, new_field_len, str);
304
305 if str = ""
306 then new_field_len = 0;
307
308 end; /* begin */
309
310 return;
311
312 update_banner:
313 entry (str);
314
315 begin;
316
317 dcl field char (banner_field_len);
318 dcl trimmed_value char (length (str)) var;
319 dcl trimmed_len fixed bin;
320
321
322 trimmed_value = ltrim (rtrim (str));
323 trimmed_len = length (trimmed_value);
324
325 if trimmed_len < banner_field_len then do;
326 call CENTER ((trimmed_value), field, " ");
327 call UPDATE (addr (data_line), 1, banner_field_len, field);
328 end;
329 else call UPDATE (addr (data_line), 1, banner_field_len, str);
330
331 end; /* begin */
332
333 return;
334
335 update_current: entry (str);
336
337 /* AUTOMATIC */
338
339 dcl uc_nl_index fixed bin;
340
341
342
343
344 used_cols = 2 * max (total_field_len, new_field_len);
345
346 current_field_len = window_image_width - used_cols;
347
348 begin;
349
350 dcl field char (current_field_len);
351 dcl trimmed_value char (length (str)) var;
352 dcl trimmed_len fixed bin;
353 dcl starting_col fixed bin;
354
355 starting_col = total_field_len + 1;
356
357 call RAW_UPDATE (addr (data_line), total_field_len + 1,
358 window_image_width - total_field_len - new_field_len,
359 copy (" ", window_image_width - total_field_len - new_field_len));
360
361 uc_nl_index = index (str, xs_NL);
362 if uc_nl_index = 0
363 then trimmed_value = ltrim (rtrim (str));
364 else trimmed_value = ltrim (rtrim (substr (str, 1, uc_nl_index - 1))) || "...";
365 trimmed_len = length (trimmed_value);
366
367 if trimmed_len < current_field_len then do;
368 call CENTER ((trimmed_value), field, " ");
369 call UPDATE (addr (data_line), starting_col, current_field_len, field);
370 end;
371 else call UPDATE (addr (data_line), starting_col, current_field_len, str);
372
373 end; /* begin */
374
375 return;
376
377 update_title: entry (str);
378
379 begin;
380
381 dcl field char (title_field_len);
382 dcl trimed_value char (length (str)) var;
383 dcl trimed_value_len fixed bin;
384
385 trimed_value = ltrim (rtrim (str));
386 trimed_value_len = length (trimed_value);
387
388 call CENTER (" " || trimed_value || " ", field, "-");
389
390 call UPDATE (addr (title_line), 1, title_field_len, field);
391
392 end;
393
394 return;
395
396 redisplay:
397 entry (P_code);
398
399 dcl P_code fixed bin (35);
400
401 status_window (1) = title_line;
402 status_window (2) = data_line;
403
404 call window_display_ (xforum_windows.status.iocb, status_window,
405 P_code);
406 call window_$sync (xforum_windows.status.iocb, P_code);
407
408 call xforum_help_line_$redisplay;
409
410 return;
411
412 CENTER:
413 proc (P_str, P_field, P_pad);
414
415 dcl (P_str, P_field) char (*);
416 dcl P_pad char (1);
417 dcl (field_len, str_len, n_pad, l_pad, r_pad)
418 fixed bin;
419
420 field_len = length (P_field);
421 str_len = length (P_str);
422
423 if str_len >= field_len then do;
424 P_field = P_str;
425 return;
426 end;
427 n_pad = field_len - str_len;
428 l_pad = divide (n_pad, 2, 17, 0);
429 r_pad = l_pad + mod (n_pad, 2);
430 P_field = copy (P_pad, l_pad) || P_str || copy (P_pad, r_pad);
431
432 end CENTER;
433
434 RIGHT_JUSTIFY:
435 proc (P_str, P_field);
436
437 dcl (P_str, P_field) char (*);
438 dcl (field_len, str_len, n_pad)
439 fixed bin;
440
441 field_len = length (P_field);
442 str_len = length (P_str);
443
444 if str_len >= field_len then do;
445 P_field = P_str;
446 return;
447 end;
448
449 n_pad = field_len - str_len;
450
451 P_field = copy (" ", n_pad) || P_str;
452
453
454 end RIGHT_JUSTIFY;
455
456 UPDATE:
457 proc (line_ptr, col, len, new_value);
458
459 dcl line_ptr ptr;
460 dcl (col, len) fixed bin,
461 new_value char (*);
462 dcl short_new_value defined (new_value) char (len),
463 trunc_new_value defined (new_value)
464 char (len - length (TRUNCATION_STRING));
465 dcl TRUNCATION_STRING init ("....") char (4) static options (constant);
466
467 if len >= length (new_value) then
468 call RAW_UPDATE (line_ptr, col, len, new_value);
469 else if len <= length (TRUNCATION_STRING)
470 | len >= length (rtrim (new_value)) then
471 call RAW_UPDATE (line_ptr, col, len, short_new_value);
472 else do;
473 call RAW_UPDATE (line_ptr, col, length (trunc_new_value),
474 trunc_new_value);
475 call RAW_UPDATE (line_ptr, col + length (trunc_new_value),
476 length (TRUNCATION_STRING), TRUNCATION_STRING);
477 end;
478
479
480 end UPDATE;
481
482 RAW_UPDATE:
483 proc (ru_line_ptr, col, len, new_value);
484
485 dcl ru_line_ptr ptr;
486 dcl (col, len) fixed bin,
487 new_value char (*);
488 dcl ru_line char (132) based (ru_line_ptr);
489
490 dcl field_p ptr,
491 field_l fixed bin,
492 field char (field_l) based (field_p);
493
494
495 field_p = addr (substr (ru_line, col));
496 field_l = len;
497 if char (new_value, len) ^= field then
498 field = new_value;
499
500 end RAW_UPDATE;
501
502 end xforum_status_;
SOURCE FILES USED IN THIS COMPILATION.
LINE NUMBER DATE MODIFIED NAME PATHNAME
0 04/18/00 1128.7 xforum_status_.pl1 >udd>sm>ds>w>ml>xforum_status_.pl1
248 1 12/03/84 1341.6 xforum_windows.incl.pl1 >ldd>incl>xforum_windows.incl.pl1
1-12 2 09/12/84 1016.7 window_control_info.incl.pl1 >ldd>incl>window_control_info.incl.pl1
250 3 09/12/84 1016.7 window_dcls.incl.pl1 >ldd>incl>window_dcls.incl.pl1
NAMES DECLARED IN THIS COMPILATION.
IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES
(* indicates a set context)
NAMES DECLARED BY DECLARE STATEMENT.
P_code parameter fixed bin(35,0) dcl 399 set ref 396 404* 406*
P_field parameter char packed unaligned dcl 437 in procedure
"RIGHT_JUSTIFY" set ref 434 441 445* 451*
P_field parameter char packed unaligned dcl 415 in procedure "CENTER" set
ref 412 420 424* 430*
P_pad parameter char(1) packed unaligned dcl 416 ref 412 430 430
P_str parameter char packed unaligned dcl 437 in procedure
"RIGHT_JUSTIFY" ref 434 442 445 451
P_str parameter char packed unaligned dcl 415 in procedure "CENTER" ref
412 421 424 430
TRUNCATION_STRING 000000 constant char(4) initial packed unaligned dcl 465 set ref 462 469 475
475 475*
addr builtin function dcl 227 ref 200 273 273 301 301 303 303 327 327 329
329 357 357 369 369 371 371 390 390 495
banner_field_len 000010 internal static fixed bin(17,0) dcl 205 set ref 260* 317 325 327* 329*
char builtin function dcl 227 ref 497
col parameter fixed bin(17,0) dcl 460 in procedure "UPDATE" set ref 456 467* 469*
473* 475
col parameter fixed bin(17,0) dcl 486 in procedure "RAW_UPDATE" ref 482 495
copy builtin function dcl 227 ref 357 357 430 430 451
current_field_len 000011 internal static fixed bin(17,0) dcl 205 set ref 260* 346* 350 367 369* 371*
data_line 000012 internal static char(132) initial packed unaligned dcl 205 set ref 273 273 301
301 303 303 327 327 329 329 357 357 369 369 371
371 402
divide builtin function dcl 227 ref 428
extent 5 000330 external static structure level 4 dcl 1-5
field based char packed unaligned dcl 490 in procedure "RAW_UPDATE"
set ref 497 497*
field 000100 automatic char packed unaligned dcl 350 in begin block on line 348
set ref 368* 369*
field 000100 automatic char packed unaligned dcl 381 in begin block on line 379
set ref 388* 390*
field 000100 automatic char packed unaligned dcl 288 in begin block on line 286
set ref 300* 301*
field 000100 automatic char packed unaligned dcl 317 in begin block on line 315
set ref 326* 327*
field_l 000102 automatic fixed bin(17,0) dcl 490 set ref 496* 497 497
field_len 000100 automatic fixed bin(17,0) dcl 417 in procedure "CENTER" set ref 420* 423 427
field_len 000100 automatic fixed bin(17,0) dcl 438 in procedure "RIGHT_JUSTIFY" set ref 441*
444 449
field_p 000100 automatic pointer dcl 490 set ref 495* 497 497
index builtin function dcl 227 ref 361
iocb 000330 external static pointer level 3 dcl 1-5 set ref 404* 406*
l_pad 000103 automatic fixed bin(17,0) dcl 417 set ref 428* 429 430
len parameter fixed bin(17,0) dcl 460 in procedure "UPDATE" set ref 456 462 462
467 467* 469 469 469*
len parameter fixed bin(17,0) dcl 486 in procedure "RAW_UPDATE" ref 482 496 497
length builtin function dcl 227 ref 252 270 283 289 297 318 323 351 365 382
386 420 421 441 442 462 467 469 469 473 473 475
475 475
line_ptr parameter pointer dcl 459 set ref 456 467* 469* 473* 475*
ltrim builtin function dcl 227 ref 295 322 362 364 385
max builtin function dcl 227 ref 344
min builtin function dcl 227 ref 252
mod builtin function dcl 227 ref 429
n_pad 000102 automatic fixed bin(17,0) dcl 417 in procedure "CENTER" set ref 427* 428 429
n_pad 000102 automatic fixed bin(17,0) dcl 438 in procedure "RIGHT_JUSTIFY" set ref 449*
451
new_field_len 000053 internal static fixed bin(17,0) dcl 205 set ref 256* 260 283* 288 293 299 301* 303*
305* 344 357 357 357
new_value parameter char packed unaligned dcl 460 in procedure "UPDATE" set
ref 456 467 467* 469 469 469 473 473 473 473 473
473 475 475
new_value parameter char packed unaligned dcl 486 in procedure "RAW_UPDATE"
ref 482 497 497
position 2 000330 external static structure level 3 dcl 1-5
r_pad 000104 automatic fixed bin(17,0) dcl 417 set ref 429* 430
rtrim builtin function dcl 227 ref 270 283 295 322 362 364 385 469
ru_line based char(132) packed unaligned dcl 488 set ref 495
ru_line_ptr parameter pointer dcl 485 ref 482 495
short_new_value defined char packed unaligned dcl 462 set ref 469*
starting_col 000101 automatic fixed bin(17,0) dcl 353 in begin block on line 348 set ref 355* 369*
371*
starting_col 000101 automatic fixed bin(17,0) dcl 291 in begin block on line 286 set ref 293* 301*
303*
static_window_image 000156 internal static char(132) initial array packed unaligned dcl 205 set ref 200
252
status 000330 external static structure level 2 dcl 1-5
status_window 000054 internal static char(132) initial array packed unaligned dcl 205 set ref 401*
402* 404*
str parameter char packed unaligned dcl 268 set ref 265 270 270 273*
275 280 283 283 289 295 303* 305 312 318 322 329*
335 351 361 362 364 371* 377 382 385
str_len 000101 automatic fixed bin(17,0) dcl 417 in procedure "CENTER" set ref 421* 423 427
str_len 000101 automatic fixed bin(17,0) dcl 438 in procedure "RIGHT_JUSTIFY" set ref 442*
444 449
substr builtin function dcl 227 ref 364 495
title_field_len 000260 internal static fixed bin(17,0) dcl 205 set ref 258* 381 390*
title_line 000261 internal static char(132) initial packed unaligned dcl 205 set ref 390 390 401
total_field_len 000322 internal static fixed bin(17,0) dcl 205 set ref 256* 260 270* 273* 275* 344 355 357
357 357 357
trimed_value 000100 automatic varying char dcl 382 set ref 385* 386 388
trimed_value_len 000100 automatic fixed bin(17,0) dcl 383 set ref 386*
trimmed_len 000100 automatic fixed bin(17,0) dcl 352 in begin block on line 348 set ref 365* 367
trimmed_len 000100 automatic fixed bin(17,0) dcl 319 in begin block on line 315 set ref 323* 325
trimmed_len 000100 automatic fixed bin(17,0) dcl 290 in begin block on line 286 set ref 297* 299
trimmed_value 000100 automatic varying char dcl 289 in begin block on line 286 set ref 295* 297
300
trimmed_value 000100 automatic varying char dcl 351 in begin block on line 348 set ref 362* 364*
365 368
trimmed_value 000100 automatic varying char dcl 318 in begin block on line 315 set ref 322* 323
326
trunc_new_value defined char packed unaligned dcl 462 set ref 473 473 473* 475
uc_nl_index 000113 automatic fixed bin(17,0) dcl 339 set ref 361* 362 364
used_cols 000100 automatic fixed bin(17,0) dcl 199 set ref 344* 346
width 5 000330 external static fixed bin(17,0) level 5 dcl 1-5 ref 252
window_$sync 000332 constant entry external dcl 3-44 ref 406
window_display_ 000324 constant entry external dcl 192 ref 404
window_image based char array packed unaligned dcl 244 set ref 254*
window_image_ptr 000102 automatic pointer initial dcl 200 set ref 200* 254
window_image_width 000323 internal static fixed bin(17,0) initial dcl 205 set ref 252* 254 254 254 258 260 293
346 357 357 357
window_position_info based structure level 1 unaligned dcl 2-25
xforum_help_line_$redisplay 000326 constant entry external dcl 193 ref 408
xforum_window_info 000104 automatic structure level 1 unaligned dcl 1-8
xforum_windows 000330 external static structure level 1 dcl 1-5
xs_NL constant char(1) initial packed unaligned dcl 221 ref 361
NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED.
break_table_info based structure level 1 dcl 2-76
break_table_info_version internal static fixed bin(17,0) initial dcl 2-80
break_table_info_version_1 internal static fixed bin(17,0) initial dcl 2-80
break_table_ptr automatic pointer dcl 2-75
get_editor_key_bindings_info based structure level 1 dcl 2-151
get_editor_key_bindings_info_ptr automatic pointer dcl 2-159
get_editor_key_bindings_info_version_1 internal static char(8) initial packed unaligned dcl 2-160
line_editor_binding_count automatic fixed bin(17,0) dcl 2-121
line_editor_key_binding_info based structure level 1 dcl 2-129
line_editor_key_binding_info_ptr automatic pointer dcl 2-118
line_editor_key_binding_info_version_3 internal static char(8) initial packed unaligned dcl 2-148
line_editor_longest_sequence automatic fixed bin(17,0) dcl 2-123
more_handler_info based structure level 1 dcl 2-83
more_handler_info_ptr automatic pointer dcl 2-92
more_handler_info_version internal static fixed bin(17,0) initial dcl 2-94
more_handler_info_version_3 internal static fixed bin(17,0) initial dcl 2-94
more_prompt_info based structure level 1 dcl 2-108
more_prompt_info_ptr automatic pointer dcl 2-112
more_prompt_info_version_1 internal static char(8) initial packed unaligned dcl 2-114
more_responses_info based structure level 1 dcl 2-59
more_responses_info_ptr automatic pointer dcl 2-69
more_responses_info_version_1 internal static fixed bin(17,0) initial dcl 2-67
more_responses_version internal static fixed bin(17,0) initial dcl 2-67
set_editor_key_bindings_info based structure level 1 dcl 2-162
set_editor_key_bindings_info_ptr automatic pointer dcl 2-171
set_editor_key_bindings_info_version_1 internal static char(8) initial packed unaligned dcl 2-172
token_characters_info based structure level 1 dcl 2-97
token_characters_info_ptr automatic pointer dcl 2-104
token_characters_info_version_1 internal static char(8) initial packed unaligned dcl 2-106
window_$bell 000000 constant entry external dcl 3-6
window_$change_column 000000 constant entry external dcl 3-63
window_$change_line 000000 constant entry external dcl 3-59
window_$clear_region 000000 constant entry external dcl 3-7
window_$clear_to_end_of_line 000000 constant entry external dcl 3-9
window_$clear_to_end_of_window 000000 constant entry external dcl 3-11
window_$clear_window 000000 constant entry external dcl 3-13
window_$create 000000 constant entry external dcl 3-72
window_$delete_chars 000000 constant entry external dcl 3-15
window_$destroy 000000 constant entry external dcl 3-74
window_$edit_line 000000 constant entry external dcl 3-76
window_$get_cursor_position 000000 constant entry external dcl 3-17
window_$get_echoed_chars 000000 constant entry external dcl 3-22
window_$get_one_unechoed 000000 constant entry external dcl 3-67
window_$get_one_unechoed_char 000000 constant entry external dcl 3-67
window_$get_unechoed_chars 000000 constant entry external dcl 3-25
window_$insert_text 000000 constant entry external dcl 3-28
window_$overwrite_text 000000 constant entry external dcl 3-29
window_$position_cursor 000000 constant entry external dcl 3-31
window_$position_cursor_rel 000000 constant entry external dcl 3-36
window_$scroll_region 000000 constant entry external dcl 3-42
window_$write_raw_text 000000 constant entry external dcl 3-48
window_$write_sync_read 000000 constant entry external dcl 3-53
window_edit_line_info based structure level 1 unaligned dcl 2-177
window_edit_line_info_ptr automatic pointer dcl 2-186
window_edit_line_info_version_1 internal static char(8) initial packed unaligned dcl 2-183
window_position_info_ptr automatic pointer dcl 2-37
window_position_info_version internal static fixed bin(17,0) initial dcl 2-35
window_position_info_version_1 internal static fixed bin(17,0) initial dcl 2-35
window_status_info based structure level 1 dcl 2-45
window_status_info_ptr automatic pointer dcl 2-43
window_status_version internal static fixed bin(17,0) initial dcl 2-52
window_status_version_1 internal static fixed bin(17,0) initial dcl 2-52
NAMES DECLARED BY EXPLICIT CONTEXT.
CENTER 001662 constant entry internal dcl 412 ref 326 368 388
RAW_UPDATE 002274 constant entry internal dcl 482 ref 357 467 469 473 475
RIGHT_JUSTIFY 002001 constant entry internal dcl 434 ref 300
UPDATE 002070 constant entry internal dcl 456 ref 273 301 303 327 329 369 371 390
initialize 000026 constant entry external dcl 38
redisplay 001603 constant entry external dcl 396
update_banner 000512 constant entry external dcl 312
update_current 000751 constant entry external dcl 335
update_new 000224 constant entry external dcl 280
update_title 001362 constant entry external dcl 377
update_total 000120 constant entry external dcl 265
xforum_status_ 000036 constant entry external dcl 38
THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION.
STORAGE REQUIREMENTS FOR THIS PROGRAM.
Object Text Link Symbol Defs Static
Start 0 0 2536 3072 2343 2546
Length 3356 2343 334 250 172 314
BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME
initialize 102 external procedure is an external procedure.
begin block on line 286 112 begin block uses auto adjustable storage.
begin block on line 315 116 begin block uses auto adjustable storage.
begin block on line 348 104 begin block uses auto adjustable storage.
begin block on line 379 118 begin block uses auto adjustable storage.
CENTER 75 internal procedure is called during a stack extension.
RIGHT_JUSTIFY 70 internal procedure is called during a stack extension.
UPDATE 91 internal procedure is called by several nonquick procedures.
RAW_UPDATE 68 internal procedure is called during a stack extension.
STORAGE FOR INTERNAL STATIC VARIABLES.
LOC IDENTIFIER BLOCK NAME
000010 banner_field_len initialize
000011 current_field_len initialize
000012 data_line initialize
000053 new_field_len initialize
000054 status_window initialize
000156 static_window_image initialize
000260 title_field_len initialize
000261 title_line initialize
000322 total_field_len initialize
000323 window_image_width initialize
STORAGE FOR AUTOMATIC VARIABLES.
STACK FRAME LOC IDENTIFIER BLOCK NAME
CENTER 000100 field_len CENTER
000101 str_len CENTER
000102 n_pad CENTER
000103 l_pad CENTER
000104 r_pad CENTER
RAW_UPDATE 000100 field_p RAW_UPDATE
000102 field_l RAW_UPDATE
RIGHT_JUSTIFY 000100 field_len RIGHT_JUSTIFY
000101 str_len RIGHT_JUSTIFY
000102 n_pad RIGHT_JUSTIFY
begin block on line 286 000100 field begin block on line 286
000100 trimmed_len begin block on line 286
000100 trimmed_value begin block on line 286
000101 starting_col begin block on line 286
begin block on line 315 000100 field begin block on line 315
000100 trimmed_len begin block on line 315
000100 trimmed_value begin block on line 315
begin block on line 348 000100 field begin block on line 348
000100 trimmed_value begin block on line 348
000100 trimmed_len begin block on line 348
000101 starting_col begin block on line 348
begin block on line 379 000100 trimed_value_len begin block on line 379
000100 field begin block on line 379
000100 trimed_value begin block on line 379
initialize 000100 used_cols initialize
000102 window_image_ptr initialize
000104 xforum_window_info initialize
000113 uc_nl_index initialize
THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM.
alloc_char_temp cat_realloc_chars enter_begin_block leave_begin_block call_ext_out_desc call_ext_out
call_int_this_desc call_int_other_desc return_mac alloc_auto_adj mpfx2 mdfx1
shorten_stack ext_entry ext_entry_desc int_entry_desc repeat set_chars_eis
THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM.
window_$sync window_display_ xforum_help_line_$redisplay
THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM.
xforum_windows
LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC
200 000020 38 000025 252 000044 254 000053 256 000101 258 000103 260 000105
263 000114 265 000115 270 000134 273 000157 275 000210 278 000221 280 000222
283 000240 286 000263 288 000266 289 000276 300 000313 301 000316 293 000321
295 000325 297 000363 299 000365 300 000367 301 000414 302 000444 303 000445
305 000474 308 000506 310 000507 312 000510 315 000526 317 000531 318 000541
326 000556 327 000561 322 000564 323 000622 325 000624 326 000626 327 000661
328 000713 329 000714 331 000745 333 000746 335 000747 344 000765 346 000774
348 000777 350 001002 351 001012 368 001027 369 001032 355 001035 357 001040
361 001107 362 001125 364 001163 365 001235 367 001240 368 001243 369 001276
370 001326 371 001327 373 001356 375 001357 377 001360 379 001376 381 001401
382 001411 388 001426 390 001431 385 001434 386 001472 388 001474 390 001544
392 001576 394 001577 396 001600 401 001611 402 001615 404 001620 406 001641
408 001653 410 001660 412 001661 420 001702 421 001703 423 001705 424 001707
425 001716 427 001717 428 001722 429 001724 430 001731 432 001776 434 002000
441 002021 442 002022 444 002024 445 002026 446 002035 449 002036 451 002041
454 002065 456 002067 462 002103 469 002110 473 002113 467 002116 469 002146
473 002212 475 002240 480 002272 482 002273 495 002307 496 002317 497 002321
500 002337
-----------------------------------------------------------
Historical Background
This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc.
as a contribution to computer science knowledge.
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL
and BULL HN Information Systems Inc. to the development of this operating system.
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture
for managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc.,
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .
-----------------------------------------------------------
Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
Copyright 2006 by BULL HN Information Systems Inc.
Copyright 2006 by Bull SAS
All Rights Reserved