1 /****^ *********************************************************** 2 * * 3 * Copyright, (C) Honeywell Bull Inc., 1987 * 4 * * 5 * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6 * * 7 * Copyright (c) 1972 by Massachusetts Institute of * 8 * Technology and Honeywell Information Systems, Inc. * 9 * * 10 *********************************************************** */ 11 12 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 13 /* Status */ 14 /* */ 15 /* 0) Created: November, 1969 by T. H. VanVleck */ 16 /* 1) Modified: February, 1975 by T. H. VanVleck - complete rewrite */ 17 /* 2) Modified: September,1976 by Steve Herbst - accept -pathname ctl_arg */ 18 /* 3) Modified: June, 1977 by Paul Green - diagnose zero-length info segs */ 19 /* 4) Modified: October, 1978 by Gary Dixon - complete rewrite; split into help */ 20 /* command and separate help_ subroutine. */ 21 /* Add support for check_info_segs. */ 22 /* 5) Modified: April, 1985 by L. Adams - rewrote parsing routines to use line logic*/ 23 /* */ 24 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 25 26 /****^ HISTORY COMMENTS: 27 1) change(1986-03-05,LJAdams), approve(1986-03-05,MCR7327), 28 audit(1986-04-17,Lippard), install(1986-04-24,MR12.0-1048): 29 Changed routines to use line parsing. 30 2) change(1986-05-08,LJAdams), approve(1986-05-14,MCR7416), 31 audit(1986-06-06,Gilcrease), install(1986-06-12,MR12.0-1074): 32 Changed sort so that the ep identifier is included. This is so that 33 separate infos are maintained for each entry_point is given on the 34 command line. 35 3) change(1986-09-04,LJAdams), approve(1986-09-04,MCR7506), 36 audit(1986-10-29,GDixon), install(1986-10-30,MR12.0-1203): 37 Moved error messages for no match on srh/section and entry point not 38 found here to avoid printing duplicate error messages per info seg 39 found in search path. 40 4) change(1987-01-20,LJAdams), approve(1987-09-03,MCR7766), 41 audit(1988-08-14,GDixon), install(1988-09-13,MR12.2-1109): 42 Changed to version Vhelp_args_3. 43 5) change(1988-02-17,LJAdams), approve(1988-03-07,MCR7857), 44 audit(1988-08-14,GDixon), install(1988-09-13,MR12.2-1109): 45 Changed to check the help_args.help_data_ptr to determine if it is a 46 list_request operation. This is because when checking the validity of 47 names the lr operation must allow the (. .. ?) symbols. 48 6) change(1988-03-14,LJAdams), approve(1988-06-01,MCR7873), 49 audit(1988-08-14,GDixon), install(1988-09-13,MR12.2-1109): 50 Changed VPDinfo_seg_1 to VPDinfo_seg_2. Changed sort to eliminate 51 duplicates from sorting 360 bits to sorting 396 bits. (phx21111) 52 7) change(2020-07-30,GDixon), approve(2021-02-23,MCR10089), 53 audit(2021-03-31,Swenson), install(2021-03-31,MR12.6g-0053): 54 A) Rewrote entire help_ program. User interface changes include: 55 B) Support new block divider keywords that begin blocks in an info segment. 56 C) Change default for min_Lpgh from 4 to 15 lines. 57 Change default for max_Lpgh from 15 to terminal's page length. 58 D) Add ALL_PARAGRAPHS label constant for use by new all_paragraphs response. 59 E) For subroutine info seg, -section/-search use find_ep to look for matching 60 entrypoint, then call section/search response to position within that ep. 61 8) change(2022-06-06,GDixon), approve(2022-06-06,MCR10101), 62 audit(2022-07-27,Swenson): 63 Change help_ to support several single-entrypoint subroutine info blocks 64 in a single info segment. 65 END HISTORY COMMENTS */ 66 %page; 67 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 68 /* */ 69 /* SUBROUTINE: help_ */ 70 /* */ 71 /* This subroutine implements the help command. It performs the following functions. */ 72 /* */ 73 /* 1) Finds info segments. */ 74 /* 2) Selects particular infos within multi-info segments. */ 75 /* 3) Sorts the list of infos to be processed. */ 76 /* 4) Processes each info, implementing all help control arguments and query responses. */ 77 /* */ 78 /* The subroutine may also be used to implement a help-style information facility in */ 79 /* other subsystems. Information segments (with an info suffix or another suffix) are */ 80 /* selected and printed, based upon information given primarily in a help_args structure, */ 81 /* which is declared in help_args_.incl.pl1. */ 82 /* */ 83 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 84 %page; 85 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 86 /* */ 87 /* ENTRYPOINT: help_ */ 88 /* */ 89 /* This entrypoint builds a list of info segments selected by help_args input data; then sorts */ 90 /* that list; then walks though the list one item at a time, calling info_seg_ to parse the */ 91 /* info segment into blocks; then enters the help_ ssu_ request loop to display that parsed info */ 92 /* segment. */ 93 /* */ 94 /* */ 95 /* Usage */ 96 /* */ 97 /* The help_ subroutine must be invoked by a sequence of calls. */ 98 /* */ 99 /* 1) call help_$init to get temp segment containing help_args structure and stores the */ 100 /* current info_segments search rules in the structure. */ 101 /* 2) call help_ one or more times to select and print info segments. */ 102 /* 3) call help_$term to release the temp segment. */ 103 /* */ 104 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 105 106 help_: 107 procedure (procedure_name, Phelp_args, suffix, progress, Acode); 108 109 dcl /* Parameters */ 110 procedure_name char (*), /* Caller of help_ and help_$init. */ 111 /* 1) Owns temp segment help_args are stored in. */ 112 /* 2) Name used in error messages. */ 113 /* Phelp_args ptr, /* ptr to argument struct returned by help_$init */ 114 /* This ptr really declared in include seg: */ 115 /* help_args_.incl.pl1 */ 116 suffix char (*), /* Suffix on segs to be processed. Normally "info" */ 117 /* but may be some other suffix or "" to omit */ 118 /* suffix processing. */ 119 progress fixed bin, /* =1: bad help_args version */ 120 /* =2: no pathnames given. */ 121 /* =3: evaluating pathnames. */ 122 /* =4: finding help segs. */ 123 /* =5: -section/-search & printing help segs. */ 124 Acode fixed bin (35); /* Return code. */ 125 126 dcl PDeps ptr, 127 Ptemp ptr, 128 fcn fixed bin, /* Function to be performed by this invocation. */ 129 ( 130 HELP init (0), /* help_ */ 131 CIS init (1) /* help_$check_info_segs */ 132 ) fixed bin int static options (constant), 133 (i, j) fixed bin, 134 offset fixed bin (35); 135 136 dcl bit36 bit (36) aligned based, 137 bit72 bit (72) aligned based, 138 bit360 bit (360) aligned based; 139 %page; 140 dcl (addr, addrel, binary, char, charno, clock, currentsize, dim, dimension, divide, empty, hbound, index, lbound, length, 141 ltrim, mod, null, ptr, rel, reverse, rtrim, search, string, substr, unspec, verify) 142 builtin; 143 144 dcl (cleanup, program_interrupt) 145 condition; 146 147 dcl convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)), 148 get_line_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin), 149 get_page_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin), 150 hcs_$get_uid_file entry (char (*), char (*), bit (36) aligned, fixed bin (35)), 151 hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)), 152 153 help_listen_util_$display_prompt entry (ptr), 154 help_listen_util_$print_iPgh_range entry (ptr), 155 help_listen_util_$set_iPgh_range entry (ptr), 156 help_request_tables_$for_non_subroutine_info entry options(variable), 157 help_request_tables_$for_subroutine_info entry options(variable), 158 help_requests_$unknown_response entry (ptr, ptr, char(*), ptr, bit(1) aligned), 159 help_responses_$lep_setup entry (ptr, ptr), 160 help_util_$execute entry (ptr, ptr, char(*)), 161 help_util_$print_section entry (ptr, ptr, ptr), 162 163 info_seg_$examine_iFile entry (ptr, char(*), char(*), bit(36) aligned, fixed bin(35)) returns(ptr), 164 info_seg_$init_for_help_ entry (ptr, fixed bin(35)), 165 info_seg_$parse_iFile entry (ptr, ptr), 166 info_seg_$reinitialize entry (ptr), 167 info_seg_$terminate entry (ptr), 168 info_seg_$unthread_iBlok entry (ptr), 169 170 info_seg_util_$count_files entry (ptr) returns (fixed bin), 171 info_seg_util_$is_Subroutine_kind entry (fixed bin) returns(bit(1) aligned), 172 173 match_star_name_ entry (char (*), char (*), fixed bin (35)), 174 pathname_$component entry (char (*), char (*), char (*)) returns (char (194)), 175 release_temp_segment_ entry (char (*), ptr, fixed bin (35)), 176 search_paths_$get entry (char (*), bit (36), char (*), ptr, ptr, fixed bin, ptr, fixed bin (35)), 177 178 sort_items_$bit entry (ptr, fixed bin), 179 sort_items_$char entry (ptr, fixed bin), 180 181 ssu_$set_procedure entry (ptr, char(*), entry, fixed bin(35)); 182 183 184 dcl (error_table_$bad_seg, 185 error_table_$improper_data_format, 186 error_table_$inconsistent, 187 error_table_$incorrect_access, 188 error_table_$moderr, 189 error_table_$no_s_permission, 190 error_table_$noarg, 191 error_table_$noentry, 192 error_table_$no_info, 193 error_table_$nomatch, 194 error_table_$unimplemented_version, 195 error_table_$zero_length_seg, 196 ssu_et_$subsystem_aborted 197 ) fixed bin (35) ext static, 198 199 iox_$user_input ptr ext static, /* Used to obtain input (responses) from the user. */ 200 iox_$user_output ptr ext static, /* Used to check for line and page length of output lines */ 201 iox_$user_io ptr ext static, /* Used to check for video-based input. */ 202 video_data_$terminal_iocb ptr ext static; 203 %page; 204 /* Include file placed here so constants may be */ 205 /* referenced in label array values below. */ 206 %include info_seg_dcls_; 207 %page; 208 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 209 210 fcn = HELP; /* Perform a help function. */ 211 go to HELP_COMMON; 212 213 214 215 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 216 /* */ 217 /* ENTRYPOINT: help_$check_info_segs */ 218 /* */ 219 /* This entrypoint generates the list of info segments to be processed by the */ 220 /* check_info_segs command. It finds info segments modified since a given date, sorts */ 221 /* the list and returns it for check_info_segs to process. */ 222 /* */ 223 /* Usage */ 224 /* */ 225 /* 1) call help_$init to get temp segment containing help_args and the output list. */ 226 /* 2) call help_$check_info_segs to build and sort the list of segments to be processed. */ 227 /* 3) call help_$term to release the temp segment. */ 228 /* */ 229 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 230 231 check_info_segs: 232 entry (procedure_name, Phelp_args, suffix, progress, Acode, APPDinfo_seg); 233 234 dcl APPDinfo_seg ptr; /* Ptr to output structure returned by */ 235 /* help_$check_info_segs */ 236 237 fcn = CIS; /* Perform a check_info_segs function. */ 238 APPDinfo_seg = null(); /* - initialize output argument for this function. */ 239 240 241 /* -------------------------------------------------------------------------------- 242 progress = 1: Check version of help_args input structure. 243 -------------------------------------------------------------------------------- */ 244 245 HELP_COMMON: 246 progress = 1; 247 Acode = 0; /* Initialize error code. */ 248 249 if help_args.version = 1 | help_args.version = 2 then do 250 help_args.version = Vhelp_args_3; /* - Ver 1 and 2 are upwards-compatible with 3 by setting*/ 251 help_args.sci_ptr = null; /* variables added in later versions to their default */ 252 help_args.help_data_ptr = null; /* values. */ 253 help_args.Sctl.inhibit_errors = F; 254 end; 255 if help_args.version ^= Vhelp_args_3 then do; /* - Report error if unsupported version. */ 256 Acode = error_table_$unimplemented_version; 257 return; 258 end; 259 260 261 /* -------------------------------------------------------------------------------- 262 progress = 2: Check that info seg paths (input data for this call) were given. 263 -------------------------------------------------------------------------------- */ 264 265 progress = 2; /* Make sure info file names were given. */ 266 if help_args.Npaths ^> 0 then do; 267 Acode = error_table_$noarg; 268 return; 269 end; 270 271 272 /* -------------------------------------------------------------------------------- 273 progress = 3: 274 A) Access help_info (hi) and info_seg_data (isd) structures. 275 B) Adjust temp segment hi.next_free_spaceP based on current size of 276 help_args structure. Presumably, caller added path(*) array 277 elements. 278 C) Evaluate input help_args.path(*) for incorrect usage errors. 279 -------------------------------------------------------------------------------- */ 280 281 progress = 3; /* Access hidden help_info structure, and other */ 282 /* structures that precede help_args in temp seg */ 283 /* (see _help_shared_data_.incl.pl1) */ 284 /* Then evaluate input paths... */ 285 286 help_infoP = ptr (Phelp_args, 0); /* - Structure at Position 1 in temp seg. */ 287 hi.help_ptrs = null(); /* - remove storage from any previous help_ call. */ 288 hi.help_labels = SUBSYSTEM_ABORTED; /* - provide some value for pi/abort labels. */ 289 hi.help_numbers = 0; 290 hi.info_ptrs = null(); 291 hi.info_switches = F; 292 293 /*dcl 1 isd aligned like info_seg_data based (hi.isdP); /* - Structure at Position 2 in temp seg */ 294 /* - setting help_infoP makes hi.isdP accessible. */ 295 /* - isd is really setup in help_$init, which */ 296 /* prepares this structure for calls to */ 297 /* info_seg_$init_for_help_ */ 298 299 hi.next_free_spaceP = Phelp_args; /* - Structure at Position 3 in temp seg. */ 300 /* - Phelp_args should be exact value returned to */ 301 /* caller of help_$init */ 302 call set_space_used (currentsize (help_args)); /* - reset hi.next_free_spaceP w/ current help_args */ 303 /* size. */ 304 305 306 do i = 1 to help_args.Npaths; /* - Examine/expand/evaluate input paths. */ 307 call evaluate_path (help_args.path (i), suffix); 308 if Acode = 0 then /* - no errors found earlier? */ 309 Acode = help_args.path.code (i); /* - return first error that occurs, so caller */ 310 end; /* knows there are errors. Caller responsible */ 311 if Acode ^= 0 then /* for displaying any errors in */ 312 return; /* help_args.path.code(i) elements. */ 313 314 %page; 315 /* -------------------------------------------------------------------------------- 316 progress = 4: Prepare to do directory searching, and to look inside 317 found info segments for any info blocks they may contain. 318 -------------------------------------------------------------------------------- */ 319 320 progress = 4; /* From here on, help_ exits by restoring help_args */ 321 /* temp segment to its length when help_ was called. */ 322 /* help_$check_info_segs returns with structures in the */ 323 /* temp segment after the help_args structure. */ 324 325 hi.help_numbers.terminal_lineL = min (HELP_LINE_SIZE_MAX, get_line_length_$switch (iox_$user_output, code)); 326 if code ^= 0 then 327 hi.terminal_lineL = HELP_LINE_SIZE_DEFAULT; /* Get user's terminal line size. */ 328 if ^help_args.Sctl.no_video & video_data_$terminal_iocb ^= null() then 329 hi.video_iocbP = iox_$user_io; /* Setup for prompt/response overwrite if video_invoked */ 330 else hi.video_iocbP = null(); /* No overwrite if -no_video or [not [wdc video_invoked]]*/ 331 hi.prompt_region = 0; 332 hi.clear_prompt_regionS = F; 333 hi.help_video_data.hvd_pad = F; 334 335 hi.help_numbers.infos_printedN = 0; /* - No info segs printed so far. */ 336 /* (tested at EXIT_NO_MATCH label below) */ 337 hi.help_numbers.newline_Nblanks_output = 0; /* - No newlines emitted yet. */ 338 339 if fcn = HELP & isd.areaP = null() then do; /* Prepare to parse info segs into one or more blocks. */ 340 /* - Init not needed now if done in prior call to help_. */ 341 /* (info_seg_$init_for_help_ sets isd.areaP non-null) */ 342 /* - info_seg_ is not used by: help_$check_info_segs */ 343 /* (fcn = CIS) */ 344 call info_seg_$init_for_help_ (addr (isd), Acode); 345 if Acode ^= 0 then /* Note: isd storage was setup by help_$init */ 346 return; 347 end; 348 349 /* ----------------------------------------------------------------- 350 Directory search generates a Dinfo structure stored in temp seg 351 (after help_args structure). 352 Subsequent call to parse info seg into blocks adds one 353 Dinfo.seg(I) array element for each matching info block. 354 - For purposes of Dinfo structure, a subroutine info w/ :Entry: 355 dividers is treated as a "single block describing the subroutine". 356 ----------------------------------------------------------------- */ 357 358 hi.Dinfo_arrayP, PDinfo = hi.next_free_spaceP; /* - Structure at Position 4 in temp seg. */ 359 /* - Get space (after help_args) for Dinfo structure */ 360 /* PDinfo and Dinfo are declared in: */ 361 /* _help_shared_data_.incl.pl1 & */ 362 /* help_cis_args_.incl.pl1 */ 363 364 Dinfo.N = 0; /* - Dinfo.seg(I) items start as info seg descriptions */ 365 /* (1 or more for each help_args.path(*) item). */ 366 367 do i = 1 to help_args.Npaths; /* - Star convention and info_seg search paths means */ 368 /* each info path can add several Dinfo.seg(I) items. */ 369 /* Each .seg(I) is then expanded to include one */ 370 /* .seg(I) item for each matching info block found in */ 371 /* one of those info segs. */ 372 373 if help_args.path (i).S.less_greater /* - dir components given in help_args.path(i)? */ 374 | help_args.Nsearch_dirs = 0 then /* OR caller gave no info search paths? */ 375 call get_info_seg_list (suffix, fcn, help_args.path (i).dir (*), help_args.path (i), PDinfo); 376 /* - don't use info_segs (or other) search paths */ 377 else call get_info_seg_list (suffix, fcn, help_args.search_dirs (*), help_args.path (i), PDinfo); 378 end; /* - do use info_segs (or other) search paths. */ 379 380 if Dinfo.N <= 0 then /* - Stop if no matching Dinfo_seg (blocks) were found. */ 381 go to EXIT_NO_MATCH; 382 call set_space_used ( currentsize (Dinfo) ); /* Record space used for Dinfo structure in temp segment. */ 383 384 %page; 385 /* -------------------------------------------------------------------------------- 386 progress = 5: Create an array of pointers to Dinfo.seg(I) items that can be sorted 387 based on values at various offsets within each Dinfo.seg(I) structure. 388 -------------------------------------------------------------------------------- */ 389 390 progress = 5; /* Infos selected by starname. Any other errors */ 391 /* reported via Acode describe info selection by */ 392 /* -search and -section criteria (done below). */ 393 394 hi.Dinfo_sort_ptrsP, PPDinfo_seg = hi.next_free_spaceP;/* - Structure at Position 5 in temp seg. */ 395 /* PDinfo_seg is declared in help_cis_args_.incl.pl1 */ 396 397 PDinfo_seg.version = VPDinfo_seg_3; /* PDinfo_seg is returned by help_$check_info_segs so it */ 398 /* has: a .version element. */ 399 PDinfo_seg.N = Dinfo.N; /* a .N element: count of ptrs returned. */ 400 /* a .P element: points to each Dinfo.seg(*) item. */ 401 /* - these pointers get sorted by next steps. */ 402 403 /* * * * * * * * * * * * * * * * * * * * * * * */ 404 /* */ 405 /* Sort pointers to found blocks three times: */ 406 /* 1st: sort on Dinfo.seg.uid/.I/.E/.X combo to detect duplicate */ 407 /* infos. Duplicates are eliminated from list. */ 408 /* 2nd: sort on Dinfo.seg.ent to identify versions of info seg in */ 409 /* different dirs. */ 410 /* 3rd: sort on Dinfo.seg.Scross_ref/.ent combination to */ 411 /* alphabetize output. */ 412 /* */ 413 /* * * * * * * * * * * * * * * * * * * * * * * */ 414 415 if Dinfo.N = 1 then /* Skip sorting if only 1 info seg/block was found. */ 416 PDinfo_seg.P (1) = addr (Dinfo.seg (1).ent); 417 418 else /* 1st: sort on Dinfo.seg.uid/.I/.E/.X combo */ 419 SORT_STEP_1: /* to detect duplicate infos. */ 420 do; 421 do i = 1 to Dinfo.N; 422 PDinfo_seg.P (i) = addr (Dinfo.seg (i).uid); /* - point to Dinfo.seg.uid of array element */ 423 Dinfo.seg (i).X = i; /* - .X indicates order in which blocks were found */ 424 end; /* relative to help_args.paths input specification, */ 425 /* & order of help_args.search_dirs (info_segs paths) */ 426 427 call sort_items_$bit (addr (PDinfo_seg.N), 11 * BITS_PER_WORD); 428 /* - Sort on content of 11 words starting at */ 429 /* Dinfo.seg(*).uid : 1 for uid */ 430 /* 1 for block offset w/in info */ 431 /* 8 for info seg entryname */ 432 /* 1 for order found by search */ 433 434 offset = binary (rel (addr (Dinfo.seg (1).ent))) - binary (rel (addr (Dinfo.seg (1).uid))); 435 /* - Compute offset to change pointers from */ 436 /* Dinfo.seg.uid to point to Dinfo.seg.ent */ 437 438 do i = 1 to Dinfo.N while (PDinfo_seg.P (i) -> bit72 = "0"b); 439 PDinfo_seg.P (i) = addrel (PDinfo_seg.P (i), offset); 440 end; /* Adjust offset in ERROR entries. These have duplicate */ 441 /* .uid/.I combos (zero bits set when error detected). */ 442 /* Avoid eliminating these duplicates so the */ 443 /* errors can be reported. The 1st sort call (above) */ 444 /* moved pointers to such error items to top of list. */ 445 446 if i > Dinfo.N then /* If all info segs are in error, skip the */ 447 go to SKIP_ELIMINATION; /* elimination of duplicates. */ 448 j = i - 1; /* j+1 will be index of pointer to retained items in */ 449 /* the CHECK(i) code below. */ 450 451 go to CHECK (fcn); /* Checking differs by help_ entrypoint. */ 452 453 CHECK (HELP): 454 do i = i to Dinfo.N - 1; /* Eliminate duplicate .uid/.I/.E combos for non-errant */ 455 /* Dinfo.seg(I) items. */ 456 if PDinfo_seg.P (i) -> bit360 ^= PDinfo_seg.P (i + 1) -> bit360 then do; 457 j = j + 1; /* (Only retain unique .uid/.I/.E combos.) */ 458 PDinfo_seg.P (j) = addrel (PDinfo_seg.P (i), offset); 459 end; 460 else PDinfo_seg.P (i + 1) = PDinfo_seg.P (i); 461 end; /* (Retain info found earliest in search rules). */ 462 go to END_CHECK; 463 464 CHECK (CIS): 465 do i = i to Dinfo.N - 1; /* Eliminate duplicate .uid combos. */ 466 if PDinfo_seg.P (i) -> bit36 ^= PDinfo_seg.P (i + 1) -> bit36 then do; 467 j = j + 1; /* (Only retain unique .uid combos.) */ 468 PDinfo_seg.P (j) = addrel (PDinfo_seg.P (i), offset); 469 end; 470 else PDinfo_seg.P (i + 1) = PDinfo_seg.P (i); 471 end; /* (Retain info found earliest in search rules). */ 472 473 END_CHECK: 474 j = j + 1; /* (Always retain the last entry in the list.) */ 475 PDinfo_seg.P (j) = addrel (PDinfo_seg.P (i), offset); 476 PDinfo_seg.N = j; /* Reset count of pointers to those being retained. */ 477 478 end SORT_STEP_1; 479 480 %page; 481 SKIP_ELIMINATION: /* 2nd: sort on Dinfo.seg.ent to identify */ 482 /* versions of info seg in different dirs. */ 483 484 call set_space_used ( currentsize(PDinfo_seg) ); /* Record space used by PDinfo_seg structure in temp seg */ 485 /* now that duplicates have been eliminated. */ 486 487 if PDinfo_seg.N = 1 then do; 488 PDinfo_seg.P (1) = addr (Dinfo.seg (1).Scross_ref); 489 goto SORT_END; 490 end; 491 492 else 493 SORT_STEP_2: 494 do; /* Sort alphabetically by ent to identify info */ 495 /* segments appearing in more than one search dir. */ 496 call sort_items_$char (addr (PDinfo_seg.N), length(Dinfo.seg (1).ent) ); 497 498 offset = binary (rel (addr (Dinfo.seg (1).Scross_ref))) - binary (rel (addr (Dinfo.seg (1).ent))); 499 /* Compute offset to change pointers from */ 500 /* Dinfo.seg.ent to point to Dinfo.seg.Scross_ref */ 501 502 PDinfo_seg.P (1) = addrel (PDinfo_seg.P (1), offset); 503 do i = 1 to Dinfo.N - 1; /* Check for entry of same name in different dirs. */ 504 PDinfo_seg.P (i + 1) = addrel (PDinfo_seg.P (i + 1), offset); 505 if PDinfo_seg.P (i) -> Dinfo_seg.ent = PDinfo_seg.P (i + 1) -> Dinfo_seg.ent 506 & PDinfo_seg.P (i) -> Dinfo_seg.uid ^= PDinfo_seg.P (i + 1) -> Dinfo_seg.uid 507 & PDinfo_seg.P (i) -> Dinfo_seg.uid ^= "0"b & "0"b ^= PDinfo_seg.P (i + 1) -> Dinfo_seg.uid then do; 508 /* Mark all but entry found earliest in search */ 509 /* rules with a cross reference flag. */ 510 511 if binary (rel (PDinfo_seg.P (i)), 18) < binary (rel (PDinfo_seg.P (i + 1)), 18) then do; 512 Ptemp = PDinfo_seg.P (i); /* - Swap to make ptr to first found item later in list. */ 513 PDinfo_seg.P (i) = PDinfo_seg.P (i + 1); 514 PDinfo_seg.P (i + 1) = Ptemp; 515 end; 516 PDinfo_seg.P (i) -> Dinfo_seg.Scross_ref = T; 517 end; /* - Turn on Scross_ref in dup item (now lowest in list) */ 518 end; 519 end SORT_STEP_2; 520 521 SORT_STEP_3: 522 if PDinfo_seg.N > 1 then /* 3rd: sort on Dinfo.seg.Scross_ref/.ent */ 523 /* combination to alphabetize output. */ 524 call sort_items_$char (addr (PDinfo_seg.N), 525 CHARS_PER_WORD + length(Dinfo.seg (1).ent) ); 526 527 528 SORT_END: 529 if fcn = CIS then do; 530 APPDinfo_seg = PPDinfo_seg; /* Return pointer to PDinfo_seg to help_$check_info_segs */ 531 return; /* caller. */ 532 end; 533 %page; 534 /* help_$help_ continues processing... */ 535 call ssu_$set_prompt_mode (hi.sciP, DONT_PROMPT); /* - Disable ssu_ prompting... */ 536 537 call ssu_$set_procedure (hi.sciP, "pre_request_line", help_listen_util_$display_prompt, code); 538 /* - help_ does its own prompts with info section titles */ 539 if code ^= 0 then do; /* and "More help?" query. */ 540 call error (hi.sciP, code, "Replacing ssu_ pre_request_line procedure."); 541 goto SUBSYSTEM_ABORTED; 542 end; 543 544 call ssu_$set_procedure (hi.sciP, "post_request_line", help_listen_util_$print_iPgh_range, code); 545 /* - help_ is called by ssu_$listen to actually display */ 546 if code ^= 0 then do; /* "selected" info block paragraphs. */ 547 call error (hi.sciP, code, "Replacing ssu_ post_request_line procedure."); 548 goto SUBSYSTEM_ABORTED; 549 end; 550 551 call ssu_$set_procedure (hi.sciP, "unknown_request", help_requests_$unknown_response, code); 552 /* - help_ diagnoses "Unknown request ..." as an */ 553 if code ^= 0 then do; /* "Unknown response ..." */ 554 call error (hi.sciP, code, "Replacing ssu_ unknown_request procedure."); 555 goto SUBSYSTEM_ABORTED; 556 end; 557 558 559 hi.PI_LABEL = PROCESS; /* Establish pi handler: enter PROCESS loop */ 560 561 on program_interrupt begin; 562 hi.print_inhibitS = T; /* Tell help_ to stop printing stuff about current info */ 563 go to hi.PI_LABEL; /* block, and branch to code for next "More help?" */ 564 end; /* prompt (or display of next info segment). */ 565 566 call ssu_$set_procedure (hi.sciP, "program_interrupt", help_program_interrupt_, code); 567 if code ^= 0 then do; /* Tell ssu_listen_ to use our program_interrupt handler. */ 568 call error (hi.sciP, code, "Replacing ssu_ program_interrupt procedure."); 569 goto SUBSYSTEM_ABORTED; 570 end; 571 572 help_program_interrupt_: /* Procedure passed to ssu_$set_procedure to replace the */ 573 procedure (AsciP); /* "program_interrupt" handler of ssu_$listen. */ 574 575 dcl AsciP ptr; /* This is the ssu_ control info ptr, which it ignores. */ 576 /* All data referenced via entry variable's display ptr. */ 577 578 hi.print_inhibitS = T; /* Tell help_ to stop printing stuff about current info */ 579 hi.prompt_repeatS = T; /* block, and to displaynext "More help?" prompt. */ 580 581 /* This procedure returns to ssu_$listen handler, which */ 582 /* branches to its READ_REQUEST label, which calls the */ 583 /* pre-request-line procedure as its first action. */ 584 end help_program_interrupt_; /* That proc is our help_listen_util_$display_prompt */ 585 586 587 %page; 588 dcl 1 saved aligned, 589 2 (blokP, fileP, firstP, lastP, prevP, nextP) ptr; 590 591 PROCESS: 592 code = 0; 593 WALK_POINTERS_TO_INFO_BLOCKS: 594 do i = 1 to PDinfo_seg.N while (code = 0); /* Process each listed info in alphabetical order. */ 595 596 hi.PI_LABEL, hi.NEXT_INFO_LABEL = NEXT_INFO; /* - Once inside PROCESS loop, pi jumps to NEXT_INFO */ 597 /* "next" response also jumps to NEXT_INFO */ 598 599 saved = null; /* Nothing stored in "saved" pointers. Any saving in */ 600 /* this loop will be un-"saved" at NEXT_INFO label. */ 601 602 hi.info_ptrs = null(); /* Setup environment for processing new info block. */ 603 604 if hi.display_mode ^= DISPLAY_MODE_unset then do; 605 /* Remove use of any prior ssu_ request table. */ 606 if hi.display_mode = DISPLAY_MODE_non_subroutine then 607 call ssu_$delete_request_table (hi.sciP, addr(help_request_tables_$for_non_subroutine_info), code); 608 else if hi.display_mode = DISPLAY_MODE_subroutine then 609 call ssu_$delete_request_table (hi.sciP, addr(help_request_tables_$for_subroutine_info), code); 610 hi.display_mode = DISPLAY_MODE_unset; 611 end; 612 613 hi.Dinfo_sort_ptrsI = i; /* - Record index of PDinfo_seg.P we're using now, so */ 614 /* responses know index of Dinfo_item being displayed. */ 615 616 hi.DinfoP = PDinfo_seg.P (i); /* - Save pointer to selected Dinfo_item being displayed.*/ 617 618 if Dinfo_item.code ^= 0 then /* Print any error encountered finding info seg/block */ 619 go to INFO_ERROR; 620 621 622 if info_seg_util_$count_files (addr (isd)) > 10 then 623 REINITIALIZE: call info_seg_$reinitialize (addr (isd)); /* Avoid having more than 10 info segs initiated */ 624 625 iFileP = /* Get threaded list of blocks in this info seg. */ 626 info_seg_$examine_iFile (addr (isd), Dinfo_item.dir, Dinfo_item.ent, Dinfo_item.uid, 627 Dinfo_item.code); /* NOTE: This finds/re-uses the blocks parsed in prior */ 628 /* call to info_seg_$examine_iFile (in */ 629 /* get_info_seg_list) if fewer than 10 info segs */ 630 /* are in the list. But if info_seg_$reinitialize*/ 631 /* has released that earlier storage, this call */ 632 /* reparses the info seg. */ 633 634 if iFileP = null () & /* No iFile returned but got other iFiles earlier */ 635 isd.files.firstP ^= null () then 636 go to REINITIALIZE; /* - Release storage for prior files so this */ 637 /* new file can be processed. */ 638 639 if iFileP = null() then do; /* - Info seg parse failure. (Highly unlikely!) */ 640 Dinfo_item.code = error_table_$improper_data_format; 641 go to INFO_ERROR; 642 end; 643 644 call info_seg_$parse_iFile (addr (isd), addr (iFile)); 645 /* Complete parsing each info block into sections and */ 646 /* paragraphs. */ 647 648 iBlokP = iFile.bloks.lastP; /* - Unthread any history comment block from list. */ 649 if iBlokP ^= null () then /* NOTE: history comment may have been unthreaded */ 650 if iBlok.divider = iBlok_divider_hcom | /* during prior call to info_seg_$examine_iFile */ 651 iBlok.divider = iBlok_divider_hcom_obsolete /* in get_info_seg_list_ procedure. But that */ 652 then /* $examine_iFile data could have been released */ 653 call info_seg_$unthread_iBlok (iBlokP); /* by an info_seg_$reinitialize call. */ 654 655 656 go to INFO_STRUCT (iFile.structure); /* Range of iFile.structure values checked by earlier */ 657 /* call to get_info_seg_list. */ 658 659 INFO_STRUCT (iFile_structure_INFO_HCOM): /* Seg with :Info: or :[Info]: dividers. */ 660 INFO_STRUCT (iFile_structure_INFO): 661 do iBlokP = iFile.bloks.firstP /* - Find iBlok referenced by Dinfo_item. */ 662 repeat iBlok.sib.nextP while (iBlokP ^= null() ); 663 if charno(iBlok.P) = Dinfo_item.I then do; /* - Display that block. */ 664 665 if info_seg_util_$is_Subroutine_kind (iBlok.kind) then do; 666 /* If this is a single-entrypoint subroutine in a */ 667 /* seg possibly documenting other single-entrypoint */ 668 /* subroutines... */ 669 670 saved.blokP = iBlokP; /* temporarily unthread any other blocks. */ 671 saved.fileP = iFileP; 672 673 saved.firstP = iFile.bloks.firstP; 674 saved.lastP = iFile.bloks.lastP; 675 iFile.bloks.firstP, iFile.bloks.lastP = iBlokP; 676 677 saved.prevP = iBlok.sib.prevP; 678 saved.nextP = iBlok.sib.nextP; 679 iBlok.sib.prevP, iBlok.sib.nextP = null(); 680 end; 681 682 call display_block(); /* Display the selected block. */ 683 go to NEXT_INFO; 684 end; 685 end; 686 Dinfo_item.code = error_table_$noentry; /* Matching iBlok not found. It was there when */ 687 go to INFO_ERROR; /* get_info_seg_list just referenced it... */ 688 689 INFO_STRUCT (iFile_structure_NO_DIVIDERS): /* Seg with no dividers. 690 iBlokP = iFile.bloks.firstP; /* - Display the only block in the info segment. */ 691 call display_block(); /* NOTE: This could be single-entrypoint subroutine */ 692 go to NEXT_INFO; /* like match_star_name_$match_star_name_; */ 693 /* display_block will decide. */ 694 695 696 INFO_STRUCT (iFile_structure_INFO_SUBROUTINE_HCOM): /* Seg with :Entry: dividers. */ 697 INFO_STRUCT (iFile_structure_INFO_SUBROUTINE): 698 INFO_STRUCT (iFile_structure_SUBROUTINE): 699 iBlokP = iFile.bloks.firstP; /* - Display subroutine intro block if no entrypoint */ 700 if Dinfo_item.ep = "" then do; /* name was given. */ 701 call display_block(); 702 go to NEXT_INFO; 703 end; 704 705 dcl epI fixed bin; /* - Search for :Entry: block matching entrypoint name. */ 706 do iBlokP = iBlok.sib.nextP 707 repeat iBlok.sib.nextP while (iBlokP ^= null() ); 708 do epI = lbound(Blok_names,1) to hbound(Blok_names,1); 709 if Blok_names(epI) = Dinfo_item.ep then do; 710 call display_block(); 711 go to NEXT_INFO; 712 end; 713 end; 714 end; 715 716 Dinfo_item.code = error_table_$noentry; /* - Report error if no block for given entrypoint name. */ 717 call error (hi.sciP, Dinfo_item.code, 718 " Looking for entry point: ^a^/ in ^[link^;segment^;directory^]: ^a^[>^]^a", 719 Dinfo_item.ep, 720 binary (Dinfo_item.segment_type, 2) + 1, 721 Dinfo_item.dir, Dinfo_item.dir ^= ">", Dinfo_item.ent); 722 hi.infos_printedN = hi.infos_printedN + 1; /* - error about info counts as "printing it". */ 723 go to NEXT_INFO; 724 725 726 INFO_ERROR: 727 call error (hi.sciP, Dinfo_item.code, 728 " ^[Looking for an info block matching: ^a^/ in^;^sFor^] ^[link^;segment^;directory^]: ^a^[>^]^a", 729 (Dinfo_item.info_name ^= ""), Dinfo_item.info_name, 730 binary (Dinfo_item.segment_type, 2) + 1, 731 Dinfo_item.dir, Dinfo_item.dir ^= ">", Dinfo_item.ent); 732 /* - error about info IS NOT "printing it". */ 733 /* Do NOT increment hi.infos_printedN here! */ 734 /* That breaks multi-call of help_ in probe/mbuild */ 735 736 NEXT_INFO: /* This label is used by help_'s "next" response routine. */ 737 hi.next_free_spaceP = addr(PDinfo_seg); /* Release space used to display last info from temp seg. */ 738 call set_space_used ( currentsize(PDinfo_seg) ); /* Record space used by PDinfo_seg structure in temp seg */ 739 /* to make hi.next_free_spaceP point to the doubleword */ 740 /* after the PDinfo_seg array. */ 741 742 if saved.blokP ^= null() then do; /* Before processing NEXT_INFO argument... */ 743 /* Redo any "saved" block threads which were unthreaded. */ 744 saved.fileP->iFile.bloks.firstP = saved.firstP; 745 saved.fileP->iFile.bloks.lastP = saved.lastP; 746 saved.blokP->iBlok.sib.prevP = saved.prevP; 747 saved.blokP->iBlok.sib.nextP = saved.nextP; 748 saved = null(); /* Clear "saved" pointers for later re-use. */ 749 end; 750 751 end WALK_POINTERS_TO_INFO_BLOCKS; 752 753 SUBSYSTEM_ABORTED: /* This exit is used by help_'s "quit" response. */ 754 EXIT_NO_MATCH: /* This exit is used only by fcn = HELP. */ 755 if hi.infos_printedN = 0 then /* -section and -search didn't find any match. */ 756 Acode = error_table_$nomatch; 757 758 if isd.areaP ^= null() then /* Terminate all info segments, and cleanup storage used */ 759 call info_seg_$reinitialize (addr(isd)); /* by the info_seg_ facility. */ 760 761 hi.next_free_spaceP = hi.help_argsP; /* Remove temp seg data beyond the current help_args */ 762 call set_space_used ( currentsize(help_args) ); /* structure. */ 763 call hcs_$truncate_seg (Phelp_args, binary (rel (Phelp_args)) + currentsize (help_args), 0); 764 /* help_ is now ready to be called again. */ 765 766 return; /* This is the main return from help_$help_ to its caller */ 767 768 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 769 %page; 770 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 771 /* * 772 ORDER OF PROCESSING help_args.Sctl arguments: [taken from earlier version of help_ routine: help_rql_.pl1] 773 774 - Some help_args values continue selection of which info blocks to display; 775 they examine info block attributes and/or contents. These include: 776 777 help_args 778 .min_date_time mostly ignored by help_$help_; help_$init disables this test; never set by help.pl1). 779 780 781 .Sctl.scn: copy -section args to local storage \ arg values become defaults if 1st...Ith response given 782 .Sctl.srh copy -search args to local storage / w/o args. Each time args are given, the new args become 783 defaults for later responses given without args. 784 for hi.display_mode = 785 non_subroutine: If block does not have any section with title matching a -section STR; and/or 786 if block does not have any paragraph matching a -search STR ... 787 then that block is totally ignored by display_block (see below). 788 If a second instance of file was found later in info_seg search paths, 789 that file is promoted to primary candidate and is also tested for 790 matching the -section titles and/or -search paragraphs. 791 792 subroutine: With no entrypoint name given (ie, iBlok points to subr intro block): 793 then select an :Entry: block by searching through all :Entry: blocks 794 looking for -section/search match. First matching block is selected for display. 795 If no matching :Entry: block found, display subroutine intro block ignoring -section/-search. 796 With specific entrypoint given: 797 then -section/search applies only to that :Entry: block as described for non-subroutine block. 798 799 800 - Other help_args values control how info block is displayed... 801 802 .Sctl.he Display only a header for selected info block. 803 804 805 .Sctl.bf Display only brief summary of Syntax, Arguments, Control arguments and List of ... sections. 806 For hi.display_mode = subroutine, this control arg is ignored unless an :Entry: block is selected. 807 808 .Sctl.ca Display only description of matching Argument, Control argument or List of ... items. 809 For hi.display_mode = subroutine, this control arg is ignored unless an :Entry: block is selected. 810 811 .Sctl.lep: Ignored for hi.display_mode = non_subroutine. 812 For hi.display_mode = subroutine: 813 create and print list of entrypoint names for any subroutine block. Then prompt 814 user before displaying subroutine introduction block, so user may use ep request 815 to select a subr_$entrypoint block to display instead. 816 [NOTE: If -lep is not given, the subr_ introduction block is displayed automatically 817 (along with a list of entrypoints), then the user is prompted. Thus, 818 -lep suppresses auto-display of subr_ introduction.] 819 820 821 .Sctl.all: Display without prompting user... 822 823 for hi.display_mode = 824 non_subroutine: all lines in current block 825 826 subroutine: with no entrypoint name given: all intro and Entry blocks; 827 with specific entrypoint given: all lines for that :Entry: block. 828 829 830 .Sctl.title Display section titles of current block. Then prompt for first section(s) of block. 831 /* * 832 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 833 %page; 834 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 835 /* */ 836 /* INTERNAL PROCEDURE: display_block */ 837 /* */ 838 /* REFERENCES caller-supplied variables instead of parameters: */ 839 /* help_infoP points to help_info (hi) structure containing global help_ information. */ 840 /* hi.DinfoP points to Dinfo_item structure for current item in "selected info blocks". */ 841 /* iFileP points to iFile structure for info seg containing block to be displayed. */ 842 /* */ 843 /* This scheme permits display_block to use caller-declarations for Dinfo_item, iFile, and iBlok */ 844 /* structures. Values for three variables above are NOT changed by display_block. */ 845 /* */ 846 /* USURPS caller-supplied variables: */ 847 /* iBlokP points to iBlok structure for block to be displayed. Set by caller, this */ 848 /* is changed only if user response selects a different block to display in */ 849 /* same info segment; iBlokP then points to iBlok of new block to display before */ 850 /* branching to hi.ANOTHER_BLOCK_LABEL. (e.g., find_ep or find responses) */ 851 /* iSectP points to iSect structure for current section. */ 852 /* iPgh points to iPgh structure for a paragraph of interest. */ 853 /* iLineP points to iLine structure for a line of interest. */ 854 /* */ 855 /* Shared REFERENCE and USURPing of variables permits the complex structures based on these */ 856 /* variables to be declared only once in their respective include files, rather than having to */ 857 /* be declared again in many support subroutines and response routines. */ 858 /* */ 859 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 860 861 display_block: 862 proc (); 863 864 if iFileP = null() then do; /* Assert: caller's iFileP should not be null(). */ 865 call error (hi.sciP, error_table_$noentry, " iFileP null in: ^a^[>^]^a^[$^a^;^s^]^[ info: ^a^;^s^]", 866 Dinfo_item.dir, (Dinfo_item.dir ^= ">"), Dinfo_item.ent, 867 (Dinfo_item.ep ^= ""), Dinfo_item.ep, 868 (Dinfo_item.info_name ^= ""), Dinfo_item.info_name); 869 return; 870 end; 871 872 if iBlokP = null() then do; /* Assert: caller's iBlokP should not be null(). */ 873 call error (hi.sciP, error_table_$noentry, " iBlokP null in: ^a^[>^]^a^[$^a^;^s^]^[ info: ^a^;^s^]", 874 Dinfo_item.dir, (Dinfo_item.dir ^= ">"), Dinfo_item.ent, 875 (Dinfo_item.ep ^= ""), Dinfo_item.ep, 876 (Dinfo_item.info_name ^= ""), Dinfo_item.info_name); 877 return; 878 end; 879 880 /* ---------------------------------------------------------------------- 881 Setup appropriate ssu_ request table. 882 ---------------------------------------------------------------------- */ 883 884 dcl TABLE_POSITION_1 fixed bin int static options(constant) init(1); 885 886 hi.info_numbers = 0; /* Reset progress, display mode/limit, line counts */ 887 hi.info_switches = F; 888 889 if info_seg_util_$is_Subroutine_kind (iBlok.kind) then do; 890 hi.display_mode = DISPLAY_MODE_subroutine; /* Subroutine block */ 891 call ssu_$add_request_table (hi.sciP, addr(help_request_tables_$for_subroutine_info), 892 TABLE_POSITION_1, code); 893 end; 894 else do; /* Non-subroutine block */ 895 hi.display_mode = DISPLAY_MODE_non_subroutine; 896 call ssu_$add_request_table (hi.sciP, addr(help_request_tables_$for_non_subroutine_info), 897 TABLE_POSITION_1, code); 898 end; 899 if code ^= 0 then do; 900 call error (hi.sciP, code, 901 "Unexpected error while setting up ssu_ ^[non-subroutine^;subroutine^;help^] request table", 902 hi.display_mode); 903 goto hi.SUBSYSTEM_ABORT_LABEL; 904 end; 905 906 907 908 /* -------------------------------------------------------------------------------- 909 Step 0: Before calling ssu_$listen, assure that... 910 911 hi.storage = null => all storage associated with display of 912 prior block now released from the temp seg. 913 914 hi.selected.iPghP = null \ 915 => "Current paragraph" is at "top" of block 916 hi.selected.iSectP = null / 917 918 919 hi.iPgh_print_range = null => No "paragraph print range" has been set. 920 -------------------------------------------------------------------------------- */ 921 922 hi.info_ptrs = null(); /* Holds hi.storage, hi.selected, hi.iPgh_print_range */ 923 924 hi.iFileP = iFileP; /* Save caller-supplied pointers to info_seg_ structures */ 925 hi.iBlokP = iBlokP; /* for this block. */ 926 927 hi.block_progress = BLOCK_PROGRESS_new_block; /* Begin processing a new info block. */ 928 929 hi.info_switches.Sctl = help_args.Sctl; /* - Copy caller's control args to help_ storage for */ 930 /* this info seg. */ 931 %page; 932 /* -------------------------------------------------------------------------------- 933 Check block against help -section and help -search constraints. 934 - If block contains no matching section titles and/or paragraphs, it is skipped. 935 But... if another version of file was found in a different search directory, 936 that version is examined instead (in the next call to display_block). 937 -------------------------------------------------------------------------------- */ 938 939 hi.block_progress = BLOCK_PROGRESS_section_search; /* Apply -section/-search control args to this block. */ 940 941 dcl J fixed bin; 942 943 if hi.display_mode = DISPLAY_MODE_subroutine /* For subroutine info_seg having several blocks... */ 944 & iFile.relatives.bloks.firstP ^= iFile.relatives.bloks.lastP 945 & iBlokP = iFile.relatives.bloks.firstP then do; /* where no $entrypointname was given in pathname... */ 946 if hi.Sctl.scn | hi.Sctl.srh then do; /* then search for a matching :Entry: block. */ 947 call help_util_$execute (hi.sciP, help_infoP, "find_ep"); 948 if hi.prompt_repeatS then /* - If argument error was reported, do nothing further. */ 949 goto hi.SUBSYSTEM_ABORT_LABEL; 950 if ^hi.section_search_matchedS then /* - If no block matches -scn/-srh, ignore subr info seg */ 951 goto EP_SEARCH_FAILED; 952 end; 953 end; 954 955 if hi.Sctl.scn then do; /* Look for particular section title in info block. */ 956 call help_util_$execute (hi.sciP, help_infoP, "section"); 957 if hi.prompt_repeatS then /* - If argument error was reported, do nothing further. */ 958 goto hi.SUBSYSTEM_ABORT_LABEL; 959 if hi.section_search_matchedS then do; /* - If found, limit display to matching section. */ 960 hi.display_limit = DISPLAY_LIMIT_section; 961 goto DISPLAY_matched; 962 end; 963 end; 964 965 if hi.Sctl.srh then do; /* Search for particular strings in info block. */ 966 call help_util_$execute (hi.sciP, help_infoP, "search"); 967 if hi.prompt_repeatS then /* - If argument error was reported, do nothing further. */ 968 goto hi.SUBSYSTEM_ABORT_LABEL; 969 if hi.section_search_matchedS then do; /* - If found, limit display to matching pgh plus any */ 970 hi.display_limit = DISPLAY_LIMIT_section; /* other paragraphs following it in that section. */ 971 goto DISPLAY_matched; 972 end; 973 end; 974 975 976 if hi.Sctl.scn | hi.Sctl.srh then do; /* All searching failed... */ 977 EP_SEARCH_FAILED: /* - Ignore this info block silently... */ 978 J = hi.Dinfo_sort_ptrsI; /* but if next block has same name, consider it to be */ 979 /* a non-duplicate. Next call to display_block will */ 980 if J < PDinfo_seg.N then /* search within it for possible match. */ 981 if PDinfo_seg.P (J+1) -> Dinfo_item.Scross_ref then 982 PDinfo_seg.P (J+1) -> Dinfo_item.Scross_ref = F; 983 return; 984 end; 985 986 /* -------------------------------------------------------------------------------- 987 Step 0a: Before calling ssu_$listen: 988 989 - If -section succeeded: "Current paragraph" is at "top" of section with 990 matching section title. 991 hi.selected.iSectP points to matching section (i.e., to that section's iSect structure) 992 hi.selected.iPghP = null 993 994 hi.iPgh_print_range = null (i.e., No "print range" has been set.) 995 996 - If -search succeeded: "Current paragraph" selects paragraph matched by 997 the -search STR. This could be in same section matched 998 by any -section STR (if one was given), or in paragraph 999 of a subsequent section. 1000 hi.selected.iPghP points to matching paragraph (i.e., to that paragraph's iPgh structure) 1001 hi.selected.iSectP points to section containing matching paragraph 1002 1003 hi.iPgh_print_range = null (i.e., No "paragraph print range" has been set.) 1004 -------------------------------------------------------------------------------- */ 1005 %page; 1006 /* -------------------------------------------------------------------------------- 1007 Block has passed all constraints. 1008 - Process help control args that display specific info from the block without 1009 prompting. These include: 1010 -header -brief -control_arg -titles -lep -all 1011 -------------------------------------------------------------------------------- */ 1012 1013 DISPLAY_matched: 1014 hi.block_progress = BLOCK_PROGRESS_needs_header; /* Block header not displayed as yet. Do it only once */ 1015 /* in the code that follows. When invoked, the "header" */ 1016 /* response sets progress to: BLOCK_PROGRESS_display */ 1017 1018 hi.infos_printedN = hi.infos_printedN + 1; /* Count info as having been printed. */ 1019 1020 if hi.Sctl.he_only /* Implement -header help control arg... */ 1021 | Dinfo_item.Scross_ref then do; /* - If only printing a header, do that now and return. */ 1022 /* Same also if only reporting another version of */ 1023 /* info seg was found in a later search directory. */ 1024 call help_util_$execute (hi.sciP, help_infoP, "header"); 1025 return; 1026 end; 1027 1028 1029 if hi.display_mode = DISPLAY_MODE_subroutine then /* For subroutines, prepare to invoke list_entry_points */ 1030 /* request. Side-effect is to replace placeholder */ 1031 /* "Entry points in SUBR_REFNAME_:" section with a */ 1032 /* help_-generated list of entry points fabricated by */ 1033 /* this call. */ 1034 call help_responses_$lep_setup (hi.sciP, help_infoP); 1035 1036 1037 1038 ALL_PARAGRAPHS: /* The "all_paragraphs" request branches to this label, */ 1039 /* with hi.Sctl.XXX = F, and hi.Sctl.all = T AND... */ 1040 /* for non_subroutine: hi.iBlokP at current block */ 1041 /* for subroutine: hi.iBlokP at subr intro block */ 1042 1043 if hi.Sctl.all then do; /* Implement first parts of -all: */ 1044 hi.selected = null(); /* - Position to "top" of info block (in case -search */ 1045 hi.iPgh_print_range = null(); /* or -section repositioned in code above). */ 1046 call help_util_$execute (hi.sciP, help_infoP, "header"); 1047 end; /* - Display a header documenting lines in the block. */ 1048 /* - Continue processing... */ 1049 /* Show any -bf/-ca/-titles output before block lines. */ 1050 1051 if hi.Sctl.bf then /* Implement -brief: show brief summary of info block. */ 1052 /* (If -brief given w/o -all, "brief" request will call */ 1053 /* the "header" request if needed.) */ 1054 call help_util_$execute (hi.sciP, help_infoP, "brief"); 1055 1056 if hi.Sctl.ca then /* Implement -control_arg: show data about particular */ 1057 /* args or control args. */ 1058 /* (If -ca given w/o -all, "control_arg" request calls */ 1059 /* the "header" request if needed.) */ 1060 call help_util_$execute (hi.sciP, help_infoP, "control_arg"); 1061 1062 if hi.Sctl.title then /* Implement -titles: show section title name/count */ 1063 /* (If -titles given w/o -all, "titles" request calls */ 1064 /* the "header" request if needed.) */ 1065 call help_util_$execute (hi.sciP, help_infoP, "titles -top"); 1066 1067 1068 if hi.Sctl.lep & hi.display_mode = DISPLAY_MODE_subroutine then do; 1069 /* Implement -lep: show headers for all entrypoints */ 1070 call help_util_$execute (hi.sciP, help_infoP, "list_entry_points"); 1071 1072 /* - Normalize hi.selected to get an iSectP. */ 1073 if hi.iSectP = null() & hi.iPghP = null() then 1074 iSectP = iBlok.relatives.sects.firstP; /* - If "top", select first section of block. */ 1075 else if hi.iSectP = null & hi.iPghP ^= null() then do; 1076 iPghP = hi.iPghP; /* - If -search found paragraph, select that section */ 1077 iSectP = iPgh.relatives.sectP; 1078 end; /* - Otherwise, don't change "current section" */ 1079 1080 if iSect.type = iSect_ENTRY_POINTS_IN then do; /* - We've just displayed "Entry points in ..." list. */ 1081 /* If "current paragraph" resides in that section, */ 1082 /* move it to the next section or first ep block. */ 1083 if iSect.sib.nextP ^= null() then do; 1084 hi.iSectP = iSect.sib.nextP; /* - Move to section beyond "Entry points in..." */ 1085 hi.iPghP = null(); 1086 end; 1087 else if iBlok.sib.nextP ^= null then do; 1088 hi.iBlokP, iBlokP = iBlok.sib.nextP; /* - Move to first subroutine :Entry: block. */ 1089 hi.selected = null(); 1090 hi.another_blockS = T; 1091 end; 1092 end; 1093 end; 1094 1095 if hi.Sctl.all then 1096 DISPLAY_ALL: 1097 do; /* Remainder of -all: */ 1098 iBlokP = hi.iBlokP; /* - Reset iBlokP to current block being displayed. */ 1099 /* This could differ from code above when the */ 1100 /* all_paragraphs request transfers to the */ 1101 /* ALL_PARAGRAPHS label above. */ 1102 1103 call newline(1); /* - Separate header from 1st section of info block. */ 1104 1105 do iSectP = iBlok.sects.firstP /* - Show info block sections. */ 1106 repeat iSect.sib.nextP while (iSectP ^= null() ); 1107 call help_util_$print_section (hi.sciP, help_infoP, iSectP); 1108 end; 1109 1110 call newline (1); /* - Separate final block section from any content of */ 1111 /* of subsequent info blocks. */ 1112 1113 if iBlok.kind = iBlok_kind_SUBROUTINE_INTRO /* For subroutine intro, -all prints all entrypoints. */ 1114 | iBlok.kind = iBlok_kind_SUBROUTINE_BRIEF_INTRO then do; 1115 do iBlokP = iBlok.sib.nextP 1116 repeat iBlok.sib.nextP while (iBlokP ^= null() ); 1117 if iBlok.kind = iBlok_kind_SUBROUTINE_ENTRY then do; 1118 call newline (help_args.Lspace_between_infos); 1119 1120 hi.iBlokP = iBlokP; 1121 hi.another_blockS = T; 1122 call help_util_$execute (hi.sciP, help_infoP, "header"); 1123 1124 do iSectP = iBlok.sects.firstP /* - Show info block sections. */ 1125 repeat iSect.sib.nextP while (iSectP ^= null() ); 1126 call help_util_$print_section (hi.sciP, help_infoP, iSectP); 1127 end; 1128 end; 1129 end; 1130 end; 1131 end DISPLAY_ALL; 1132 1133 if hi.Sctl.bf | hi.Sctl.ca | hi.Sctl.all then /* If -brief, -ca or -all help control args given, we've */ 1134 return; /* done those steps. Return now. */ 1135 1136 %page; 1137 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 1138 /* * 1139 The ssu_$listen LISTENER LOOP supervises printing of help paragraphs, display of "More help?" prompts, and 1140 processing of user's response to each prompt (the response is an ssu_ request line). The LOOP consists of 1141 four-steps: 1142 1143 When entering step 1: 1144 If hi.selected.iPghP ^= null, it points to the actual "last paragraph printed" iPgh structure. 1145 1146 But if switching to a new section or paragraph... 1147 If hi.iPghP = null & 1148 hi.iSectP = null: "last paragraph printed" appears to point to a paragraph 1149 before 1st section of block. 1150 If hi.iPghP = null & 1151 hi.iSectP ^= null: "last paragraph printed" appears to point to the paragraph 1152 before that section. 1153 1154 Step 1: Uses "last paragraph printed", hi.display_limit, and count of unseen paragraphs to determine 1155 what paragraphs to display next; then tells user what they are... via a "More help?" prompt. 1156 ssu_$listen calls help_listen_util_$display_prompt to perform step 1. 1157 1158 1159 1160 When entering step 2 and for all subsequent steps: 1161 hi.iPgh_print_range.startP points to first iPgh to print. 1162 .endP points to last iPgh to print. 1163 1164 1165 hi.selected.iPghP = hi.iPgh_print_range.startP ("current paragraph" is first paragraph to be displayed) 1166 .iSectP = pointer to iSect describing section containing "current paragraph" 1167 1168 hi.prompt_repeatS = T: Nothing is printed by step 4; step 1 recomputes and displays "More help?" prompt. 1169 1170 Step 2: ssu_$listen reads and processes the user's response to that "More help?" prompt. 1171 - It break's response line into one or more ssu_ requests. 1172 - Invokes each request (which is usually a help_ response routine). 1173 - If user types an empty response line, hi.prompt_repeatS = T causes prior prompt to be redisplayed. 1174 1175 Step 3: Each help_responses_ routine can adjust hi.selected and hi.iPgh_print_range, 1176 or make no adjustments: these values select which paragraphs are to be displayed. 1177 1178 A response routine may also change: 1179 hi.display_limit: can have one of the following four values. 1180 DISPLAY_LIMIT_none => display all paragraphs that fit on the video page. 1181 DISPLAY_LIMIT_section => display only paragraphs of current section. 1182 DISPLAY_LIMIT_unseen => display only unseen paragraphs. 1183 DISPLAY_LIMIT_rest_unseen => display all remaining unseen paragraphs. 1184 To display any paragraphs in step 4, a response routine must set: 1185 hi.prompt_repeatS = F => either the incoming hi.iPgh_print_range is displayed, 1186 or an adjusted hi.selected and/or hi.iPgh_print_range displayed. 1187 1188 1189 When entering step 4: 1190 If hi.iPgh_print_range ^= null: hi.iPgh_print_range.startP and .endP delimit the exact set of 1191 paragraphs to display. 1192 = null: if both .startP is null, then... 1193 hi.selected values specify a new "current paragraph". 1194 In that case, help_listen_util_$set_iPgh_range is called to map 1195 that "current paragraph" into a new pair of hi.iPgh_print_range 1196 .startP and .endP pointers. 1197 If hi.display_limit = DISPLAY_LIMIT_section, that print range is 1198 to paragraphs of the "current paragraph"s section, 1199 limited from that current paragraph onward. 1200 1201 Step 4: If hi.prompt_repeatS ^= T, then display paragraphs of the hi.iPgh_print_range 1202 - If hi.display_limit >= DISPLAY_LIMIT_unseen, then only unseen paragraphs in print range are displayed. 1203 1204 ssu_$listen calls help_listen_util_$print_iPgh_range to perform step 4. After performing its work, 1205 it returns back to ssu_$listen... which iterates again through LOOP.... starting at step 1. 1206 1207 1208 The code below enters the ssu_ LISTENER LOOP described above by: 1209 - performing the part of step 1 that determines WHICH PARAGRAPHS TO PRINT first (w/o displaying a prompt); 1210 - displaying a HEADER describing the info block, how many lines it contains, and how many lines will be printed first. 1211 - then calling the step 4 routine directly to PRINT those first PARAGRAPHS OF THE INFO BLOCK; and finally 1212 - calling ssu_$listen to start the LOOP at step 1. 1213 1214 /* * 1215 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 1216 %page; 1217 /* ----------------------------------------------------------------- 1218 Print header for info block, and first few paragraphs. 1219 Then enter the ssu_ listener which supervises the 1220 help_ prompt/response loop. 1221 ----------------------------------------------------------------- */ 1222 1223 BLOCK_DISPLAY_BEGINS: /* Begin display of selected info seg block. */ 1224 hi.ANOTHER_BLOCK_LABEL = ANOTHER_BLOCK_OF_SAME_INFO_SEG; 1225 /* - find_info, find_ep or ep response branches back here*/ 1226 /* when user asks for different block of info seg. */ 1227 hi.ALL_PARAGRAPHS_LABEL = ALL_PARAGRAPHS; /* - all_paragraphs or all_entrypoints branches back */ 1228 /* here to display "all" of current block/subroutine */ 1229 1230 iBlokP = hi.iBlokP; /* - Make sure iBlokP points to possibly just-switched */ 1231 /* block. Block selection can occur: */ 1232 /* above: for help SUBR_ -search STRING */ 1233 /* below: at ANOTHER_BLOCK_OF_SAME_INFO_SEG label */ 1234 /* after: "find_ep", "find_info", "ep", or */ 1235 /* "info" responses, or END_OF_INFO */ 1236 /* when walking thru unseen SUBR blocks */ 1237 /* Since iBlokP isn't referenecd in code below, this */ 1238 /* is useful primarily when debugging help_. */ 1239 1240 if hi.infos_printedN > 1 then /* - Two blank lines separate one info block from next */ 1241 call newline (2); 1242 1243 if hi.display_limit > DISPLAY_LIMIT_section then /* - Turn off unseen and rest_unseen display limits */ 1244 hi.display_limit = DISPLAY_LIMIT_none; /* each time a new block is processed. */ 1245 1246 if hi.block_progress = BLOCK_PROGRESS_needs_header | hi.another_blockS then do; 1247 /* - Need some kind of header displayed for this block. */ 1248 call help_listen_util_$set_iPgh_range (hi.sciP); /* - Set initial paragraph print range. */ 1249 /* This sets hi.header_Nlines_follow for that range.*/ 1250 call help_util_$execute (hi.sciP, help_infoP, "header"); 1251 /* - Then display a header for the block. */ 1252 end; 1253 1254 if ^hi.prompt_repeatS then /* - Print the first range of paragraphs. */ 1255 call help_listen_util_$print_iPgh_range (hi.sciP); 1256 1257 call ssu_$listen (hi.sciP, iox_$user_input, code); /* - Let ssu_ listener supervise printing rest of block. */ 1258 if code = ssu_et_$subsystem_aborted then 1259 goto SUBSYSTEM_ABORTED; 1260 else if code ^= 0 then 1261 call error (hi.sciP, code, "calling ssu_$listen as help_ prompt/response routine."); 1262 return; /* - End of displaying this block. */ 1263 /* - Return to help_ caller of display_block(). */ 1264 1265 /* ----------------------------------------------------------------- 1266 Branch here with hi.iBlokP set to block to be displayed, and 1267 hi.selected = null() (start at "top" of block). Used by: 1268 - entry_point (ep), info, and find_ep (find) responses; 1269 - help_listen_util_$display_prompt goes here if displaying 1270 a subroutine intro block, to continue with 1271 first entrypoint description for that subroutine. 1272 ----------------------------------------------------------------- */ 1273 1274 ANOTHER_BLOCK_OF_SAME_INFO_SEG: /* When transferring in from find_XXX response... */ 1275 call newline (help_args.Lspace_between_infos); /* - Separate prior block's data from data in new block. */ 1276 hi.info_switches.another_blockS = T; /* - Display a block-change HEADING line for new block. */ 1277 hi.clear_prompt_regionS = F; /* - Do not clear prompts at point of switching blocks. */ 1278 goto BLOCK_DISPLAY_BEGINS; 1279 1280 end display_block; 1281 1282 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1283 %page; 1284 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1285 1286 evaluate_path: 1287 procedure (info_path, suffix); 1288 1289 dcl 1 info_path aligned like help_args.path, 1290 suffix char (*); 1291 1292 dcl i fixed bin; 1293 1294 dcl check_star_name_$entry entry (char (*), fixed bin (35)), 1295 expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); 1296 1297 info_path.dir (1) = ""; /* Initialize to unset so caller can depend on these */ 1298 info_path.ent = ""; /* values. */ 1299 info_path.ep = ""; 1300 1301 info_path.S.less_greater = (search (info_path.value, "<>") > 0); 1302 /* Was some part of dir given? */ 1303 1304 i = index (reverse (info_path.value), "$"); /* Was entrypoint name given? */ 1305 if info_path.S.less_greater then /* - Must allow $ in entry names forming dir part of path*/ 1306 if search (reverse (info_path.value), "<>") < i then 1307 i = 0; 1308 if i > 0 then /* - Save entrypoint name from user in his path input */ 1309 info_path.ep = substr (info_path.value, length (info_path.value) - i + 2); 1310 else info_path.ep = ""; 1311 1312 1313 call expand_pathname_$add_suffix (substr (info_path.value, 1, length (info_path.value) - i), suffix, 1314 info_path.dir (1), info_path.ent, info_path.code); 1315 if info_path.code ^= 0 then /* separate pathname into dir/ent parts, add info suffix */ 1316 return; 1317 1318 if info_path.S.pn_ctl_arg then /* if -pn given, assume relative pathname follows. */ 1319 info_path.S.less_greater = T; /* (Note we've already expanded path on this assumption.)*/ 1320 1321 1322 if info_path.info_name = "" then do; /* info_name usually = entryname w/o suffix. */ 1323 info_path.S.separate_info_name = F; 1324 if suffix = "" then 1325 info_path.info_name = info_path.ent; 1326 else info_path.info_name = 1327 substr (info_path.ent, 1, 32 - length (suffix) - index (reverse (info_path.ent), reverse (suffix) || ".")); 1328 end; 1329 else info_path.S.separate_info_name = T; 1330 1331 1332 call check_star_name_$entry (info_path.ent, info_path.code); 1333 1334 if info_path.code = 0 then do; /* 0 means no starname given... */ 1335 info_path.S.starname_ent = F; /* -ep argument allowed when starname not given. */ 1336 if help_args.Sctl.ep & info_path.ep = "" then /* Default ep name = entryname w/o suffix. */ 1337 if suffix = "" then 1338 info_path.ep = info_path.ent; 1339 else info_path.ep = 1340 substr (info_path.ent, 1, 32 - length (suffix) - index (reverse (info_path.ent), reverse (suffix) || ".")); 1341 end; 1342 1343 else if info_path.code = 1 | info_path.code = 2 then do; 1344 info_path.code = 0; /* 1 or 2 means starname was given... */ 1345 info_path.S.starname_ent = T; 1346 if help_args.Sctl.ep | (info_path.ep ^= "") then /* forbid -ep if starname was given. */ 1347 info_path.code = error_table_$inconsistent; 1348 end; 1349 1350 if info_path.code ^= 0 then /* Stop evaluation if error detected. */ 1351 return; 1352 1353 1354 if info_path.S.separate_info_name then do; /* Check star-ness of user-supplied info_name. */ 1355 if info_path.S.info_name_not_starname then /* - Caller asserts that info_name not starname */ 1356 info_path.S.starname_info_name = F; 1357 else do; 1358 call check_star_name_$entry (info_path.info_name, info_path.code); 1359 if info_path.code = 1 | info_path.code = 2 then do; 1360 info_path.code = 0; /* 1 or 2 means info_name is a starname... */ 1361 info_path.S.starname_info_name = T; 1362 end; 1363 else info_path.S.starname_info_name = F; 1364 end; 1365 end; 1366 else info_path.S.starname_info_name = info_path.S.starname_ent; 1367 1368 end evaluate_path; 1369 1370 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1371 %page; 1372 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1373 1374 get_info_seg_list: /* Find info blocks matching info_path */ 1375 procedure (suffix, fcn, dirs, info_path, PDinfo_); 1376 1377 /* Input Parameters */ 1378 dcl suffix char (*), /* help_$init (or caller) provided suffix for info segs. */ 1379 fcn fixed bin, /* = HELP: help_ is our caller. */ 1380 /* = CIS: help_$check_info_segs is our caller. */ 1381 dirs (*) char (168) unaligned, /* Array of directories in which to look for info segs. */ 1382 /* - Could be a specific pathname given by user; or */ 1383 /* - Array of info_seg (or other) search paths given in */ 1384 /* help_args.search_dirs */ 1385 1 info_path aligned like help_args.path, /* Structure holding one user-provided search request. */ 1386 PDinfo_ ptr; /* Points to storage reserved by caller for Dinfo struct. */ 1387 /* - We declare this as Dinfo_ structure below. */ 1388 1389 dcl I fixed bin (21), 1390 Nstart fixed bin, 1391 block_date fixed bin (71), 1392 code fixed bin (35), 1393 (i, j, k) fixed bin, 1394 linfo_name char (32), /* info name without the suffix. */ 1395 sinfo_name char (32), /* info name with the suffix. */ 1396 saved_date fixed bin (71), 1397 some_block_foundS bit (1) aligned, 1398 uid bit (36) aligned; 1399 1400 dcl 1 Dinfo_ aligned based (PDinfo_), /* Our view of caller's Dinfo structure. */ 1401 2 N fixed bin, 1402 2 item (0 refer (Dinfo_.N)), 1403 3 seg like Dinfo_seg; 1404 1405 dcl hcs_$star_dir_list_ entry (char (*), char (*), fixed bin (3), ptr, fixed bin, fixed bin, ptr, ptr, fixed bin (35)), 1406 hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); 1407 %page; 1408 Nstart = Dinfo_.N; /* Remember count of info segs found earlier, */ 1409 /* to see if we find matches for current path. */ 1410 1411 star_list_names_ptr, star_list_branch_ptr = null (); 1412 on cleanup call free_dir_list (); /* Prep to free storage by hcs_$star_dir_list_ */ 1413 1414 ENTRIES_IN_DIRS: 1415 do i = lbound (dirs, 1) to hbound (dirs, 1); /* Search for info path in each directory to be searched. */ 1416 /* May be looking in info_segs search paths. */ 1417 star_select_sw = star_ALL_ENTRIES; 1418 call hcs_$star_dir_list_ (dirs (i), info_path.ent, star_select_sw, addr (hi_area), star_branch_count, star_link_count, 1419 star_list_branch_ptr, star_list_names_ptr, code); 1420 1421 if code = 0 then 1422 STARNAME_PROCESSING: 1423 do; 1424 WALK_HCS_STAR_ARRAY: 1425 do j = 1 to star_branch_count + star_link_count; 1426 /* Process segs/links found in this directory. */ 1427 k, Dinfo_.N = Dinfo_.N + 1; 1428 Dinfo_.seg (k).Scross_ref = F; 1429 Dinfo_.seg (k).dir = dirs (i); 1430 Dinfo_.seg (k).ent = star_list_names (star_dir_list_branch (j).nindex); 1431 Dinfo_.seg (k).info_name = ""; 1432 Dinfo_.seg (k).ep, Dinfo_.seg (k).E = info_path.ep; 1433 Dinfo_.seg (k).segment_type = star_dir_list_branch (j).type; 1434 1435 /* Process by entry type... */ 1436 if star_dir_list_branch (j).type = star_SEGMENT then do; 1437 /* - For an info segment... */ 1438 Dinfo_.seg (k).L = divide (star_dir_list_branch (j).bit_count, BITS_PER_CHAR, 24, 0); 1439 Dinfo_.seg (k).date = numeric_date (star_dir_list_branch (j).dtem); 1440 Dinfo_.seg (k).mode = substr (star_dir_list_branch (j).mode, 2, 3); 1441 /* - extract access "rew" mode bits from "trewa". */ 1442 Dinfo_.seg (k).code = 0; /* - no errors encountered as yet for this info seg */ 1443 1444 if Dinfo_.seg (k).L = 0 then /* - Oops, info seg empty? */ 1445 Dinfo_.seg (k).code = error_table_$zero_length_seg; 1446 1447 else if (star_dir_list_branch (j).bit_count - (BITS_PER_CHAR * Dinfo_.seg (k).L)) > 0 then 1448 /* - bits after last whole character? */ 1449 /* [equiv to: mod(Bit_count, BIT_PER_CHAR) > 0] */ 1450 Dinfo_.seg (k).code = error_table_$bad_seg; 1451 end; 1452 1453 else if star_dir_list_branch (j).type = star_LINK then 1454 CHASE_LINK: do; /* - For link: chase link looking for target info seg */ 1455 call hcs_$status_long (Dinfo_.seg (k).dir, Dinfo_.seg (k).ent, 1, 1456 addr (branch), null (), code); 1457 1458 if (code = 0) | (code = error_table_$no_s_permission) then do; 1459 if branch.type = Segment then do; 1460 /* - Get info equivalent to above directly from branch*/ 1461 /* NOTE: we may not have "s" access to target dir */ 1462 Dinfo_.seg (k).L = divide (binary (branch.bit_count, 24), BITS_PER_CHAR, 24, 0); 1463 Dinfo_.seg (k).date = numeric_date (branch.dtem); 1464 Dinfo_.seg (k).mode = substr (branch.mode, 2, 3); 1465 Dinfo_.seg (k).code = 0; 1466 if Dinfo_.seg (k).L = 0 then 1467 Dinfo_.seg (k).code = error_table_$zero_length_seg; 1468 else if (binary (branch.bit_count, 24) - (BITS_PER_CHAR * Dinfo_.seg (k).L)) > 0 then 1469 Dinfo_.seg (k).code = error_table_$bad_seg; 1470 end; 1471 1472 else if branch.type = Link then do; 1473 /* - circular link or link chain too long */ 1474 Dinfo_.seg (k).L = 0; 1475 Dinfo_.seg (k).date = 0; 1476 Dinfo_.seg (k).mode = "0"b; 1477 Dinfo_.seg (k).code = error_table_$noentry; 1478 end; 1479 1480 else do; /* - Silently skip matching directories. */ 1481 Dinfo_.N = Dinfo_.N - 1; 1482 /* Forget everything we've done for this entry */ 1483 go to SKIP_ENTRY; 1484 end; 1485 end; 1486 1487 else do; /* - Error: no access to the link target. */ 1488 Dinfo_.seg (k).L = 0; 1489 Dinfo_.seg (k).date = 0; 1490 Dinfo_.seg (k).mode = "0"b; 1491 Dinfo_.seg (k).code = code; 1492 end; 1493 end CHASE_LINK; 1494 1495 else do; /* - Silently skip matching directories. */ 1496 Dinfo_.N = Dinfo_.N - 1; 1497 go to SKIP_ENTRY; 1498 end; 1499 1500 if Dinfo_.seg (k).code = 0 then do; /* - If no errors found while searching... */ 1501 1502 if (Dinfo_.seg (k).mode & R_ACCESS) then 1503 /* - If can read info seg... */ 1504 if help_args.min_date_time ^< Dinfo_.seg (k).date then 1505 Dinfo_.N = Dinfo_.N - 1; /* - Skip seg if older than help_args.min_date_time */ 1506 else ; /* - Else continue with this seg. */ 1507 else Dinfo_.seg (k).code = error_table_$moderr; 1508 end; /* - Error: user has no read access to info seg. */ 1509 1510 SKIP_ENTRY: end WALK_HCS_STAR_ARRAY; 1511 1512 call free_dir_list (); 1513 end STARNAME_PROCESSING; 1514 %page; 1515 else if (code = error_table_$incorrect_access | code = error_table_$no_info) & ^info_path.S.starname_ent then 1516 NON_STARNAME_PROCESSING: 1517 do; /* If user does not have "s" permission to dir, */ 1518 /* - look for a specific help seg. */ 1519 call hcs_$status_long (dirs (i), info_path.ent, 1, addr (branch), null (), code); 1520 1521 if (code = error_table_$no_s_permission) | (code = 0) then do; 1522 if branch.type ^= Directory then do; 1523 k, Dinfo_.N = Dinfo_.N + 1; 1524 Dinfo_.seg (k).Scross_ref = F; 1525 Dinfo_.seg (k).dir = dirs (i); 1526 Dinfo_.seg (k).ent = info_path.ent; 1527 Dinfo_.seg (k).info_name = ""; 1528 Dinfo_.seg (k).ep = info_path.ep; 1529 Dinfo_.seg (k).E = info_path.ep; 1530 Dinfo_.seg (k).segment_type = branch.type; 1531 1532 if branch.type = Segment then do; 1533 Dinfo_.seg (k).L = divide (binary (branch.bit_count, 24), BITS_PER_CHAR, 24, 0); 1534 Dinfo_.seg (k).date = numeric_date (branch.dtem); 1535 Dinfo_.seg (k).mode = substr (branch.mode, 2, 3); 1536 if Dinfo_.seg (k).mode & R_ACCESS then 1537 Dinfo_.seg (k).code = 0; 1538 else Dinfo_.seg (k).code = error_table_$moderr; 1539 1540 if Dinfo_.seg (k).L = 0 then 1541 Dinfo_.seg (k).code = error_table_$zero_length_seg; 1542 else if binary (branch.bit_count, 24) - BITS_PER_CHAR * Dinfo_.seg (k).L > 0 then 1543 Dinfo_.seg (k).code = error_table_$bad_seg; 1544 else if code = 0 then 1545 if help_args.min_date_time ^< Dinfo_.seg (k).date then 1546 Dinfo_.N = Dinfo_.N - 1; 1547 end; 1548 else do; /* Give error for link target being a link. */ 1549 Dinfo_.seg (k).L = 0; 1550 Dinfo_.seg (k).date = 0; 1551 Dinfo_.seg (k).mode = "0"b; 1552 Dinfo_.seg (k).code = error_table_$noentry; 1553 end; 1554 end; 1555 end; 1556 else if code = error_table_$noentry then; 1557 else go to DIR_ERROR; 1558 1559 end NON_STARNAME_PROCESSING; 1560 1561 else if code = error_table_$nomatch then; 1562 1563 else do; /* hcs_$star_dir_list fatal error looking in this dir. */ 1564 DIR_ERROR: call error (hi.sciP, code, " Looking for info segments in ^a.", dirs (i)); 1565 if dim (dirs, 1) = 1 then 1566 return; /* Avoid getting nomatch error in addition to */ 1567 end; /* this one when only 1 dir to look into. */ 1568 1569 end ENTRIES_IN_DIRS; 1570 %page; 1571 do i = Nstart + 1 to Dinfo_.N; /* Supply uid for all just-found info segs. */ 1572 call hcs_$get_uid_file (Dinfo_.seg (i).dir, Dinfo_.seg (i).ent, uid, code); 1573 if code ^= 0 & Dinfo_.seg (i).code = 0 then 1574 Dinfo_.seg (i).code = code; 1575 else if code = 0 then 1576 Dinfo_.seg (i).uid = uid; 1577 end; 1578 1579 if fcn = CIS then do; /* For help_$check_info_segs... */ 1580 do i = Nstart + 1 to Dinfo_.N; /* - in Dinfo_.seg entries just added... */ 1581 if Dinfo_.seg (i).code ^= 0 then do; /* if found an error in any of these... */ 1582 Dinfo_.seg (i).uid = "0"b; 1583 Dinfo_.seg (i).I = 0; /* - zero fields so caller cannot try to */ 1584 Dinfo_.seg (i).E = ""; /* further process this problem entry. */ 1585 end; 1586 end; 1587 return; /* - don't try to look inside info seg for blocks */ 1588 end; 1589 1590 1591 if Dinfo_.N = Nstart then do; /* For help_, if no entries found for this path */ 1592 /* - print error message on behalf of caller */ 1593 if info_path.S.starname_ent then 1594 code = error_table_$nomatch; 1595 else code = error_table_$noentry; 1596 call error (hi.sciP, code, " ^[-pn ^]^a", info_path.S.pn_ctl_arg, info_path.value); 1597 return; 1598 end; 1599 %page; 1600 EXAMINE_INFO_SEG: /* For help_, w/ no errors encountered for path... */ 1601 /* - Look in just-added info segs for :Info: */ 1602 do i = Nstart + 1 to Dinfo_.N; /* and :[Info]: info block dividers. */ 1603 1604 /* NOTE: Dinfo_.N is incremented below, but new items */ 1605 /* are NOT processed by this do group. do-statement */ 1606 /* evaluates Dinfo_.N when first entering the do-group. */ 1607 /* Subsequent increments to Dinfo_.N add items that are */ 1608 /* beyond the original Dinfo_.N limit of this do-group. */ 1609 1610 if info_seg_util_$count_files (addr (isd)) > 10 then 1611 REINITIALIZE: call info_seg_$reinitialize (addr (isd)); /* Avoid having more than 10 info segs initiated. */ 1612 1613 iFileP = 1614 info_seg_$examine_iFile (addr (isd), Dinfo_.seg (i).dir, Dinfo_.seg (i).ent, Dinfo_.seg (i).uid, 1615 Dinfo_.seg (i).code); 1616 /* Get chain of blocks found in this info seg */ 1617 1618 if iFileP = null () & /* No iFile returned but got other iFiles earlier */ 1619 isd.files.firstP ^= null () then 1620 go to REINITIALIZE; /* - Release storage for prior files so this */ 1621 /* new file can be processed. */ 1622 1623 if Dinfo_.seg (i).code ^= 0 then /* Report any errors in initiating this new file */ 1624 go to BLOCKS_error; /* ASSERT: .code ^= 0 if iFileP = null() */ 1625 1626 if help_args.pad2(6) = 3 then /* -db 3 given? */ 1627 call ioa ("DEBUG 3: iFile.caseI = ^d, .structure = ^d", iFile.caseI, iFile.structure); 1628 1629 if iFile.structure <= iFile_struc_err_UNSET 1630 | iFile.structure > iFile_structure_INFO then do; 1631 Dinfo_.seg (i).code = error_table_$improper_data_format; 1632 go to BLOCKS_error; /* Info seg has unrecognized/bad block structure */ 1633 end; 1634 1635 go to INFO_STRUCTURE (iFile.structure); /* Next steps vary by structure of info segment. */ 1636 1637 1638 INFO_STRUCTURE (iFile_structure_INFO_HCOM): /* Info Segment with blocks... */ 1639 /* - Each block treated as a separate info by help_. */ 1640 iBlokP = iFile.bloks.lastP; 1641 if iBlokP ^= null () then /* - Unthread history comment block from list. */ 1642 if iBlok.divider = iBlok_divider_hcom | iBlok.divider = iBlok_divider_hcom_obsolete then 1643 call info_seg_$unthread_iBlok (iBlokP); 1644 1645 INFO_STRUCTURE (iFile_structure_INFO): /* Info Segment with blocks but no History Comment... */ 1646 saved_date = Dinfo_.seg (i).date; /* - save info seg dtcm for any block w/o header date. */ 1647 Dinfo_.seg (i).info_name = info_path.info_name; 1648 /* save info_name which found this info, for use in any */ 1649 /* subsequent error message. */ 1650 1651 some_block_foundS = F; /* 1st matching block's data will go into existing */ 1652 /* Dinfo_.seg(i); but no match found yet. */ 1653 1654 CHECK_BLOCKS: 1655 do iBlokP = iFile.bloks.firstP /* Check block divider names versus input spec */ 1656 repeat iBlok.sib.nextP while (iBlokP ^= null ()); 1657 if iBlok.no_namesS then /* - skip block with no divider names. */ 1658 goto NEXT_BLOCK; 1659 1660 call convert_date_to_binary_ (iBlok.header.iso_date, block_date, code); 1661 if code ^= 0 then 1662 block_date = saved_date; 1663 if help_args.min_date_time ^< block_date then 1664 go to NEXT_BLOCK; /* - skip blocks older than min_date_time */ 1665 1666 CHECK_BLOCK_NAMES: 1667 do j = lbound (Blok_names, 1) to hbound (Blok_names, 1); 1668 if info_path.S.starname_info_name then do; 1669 call match_star_name_ ((Blok_names (j)), info_path.info_name, code); 1670 if code ^= 0 then 1671 go to NAME_MISMATCH; 1672 end; 1673 else if Blok_names (j) ^= info_path.info_name then 1674 go to NAME_MISMATCH; 1675 1676 if ^info_path.S.separate_info_name then do; 1677 /* AVOID POTENTIAL BUG: Lookup of info seg by */ 1678 /* uid could subvert test to see if divider name */ 1679 /* is really a name on the info seg. Check if */ 1680 /* divider name really exists on info segment. */ 1681 if iBlok.divider = iBlok_divider_Info_no_ext_names then 1682 go to NAME_MISMATCH; /* :[Info]: divider name never on phys. info seg */ 1683 1684 if suffix ^= "" then /* Look for this block name as name on phys. info */ 1685 sinfo_name = Blok_names (j) || "." || suffix; 1686 else sinfo_name = Blok_names (j); 1687 /* NOTE: If user has no "s" (status) access on containing */ 1688 /* directory, getting list of external names on seg is */ 1689 /* not allowed hcs_$status_long, etc. But... */ 1690 /* hcs_$get_uid_file can look in that dir for a given */ 1691 /* info_name; if found file, uid is returned even in */ 1692 /* directory to which user has no s permission. */ 1693 call hcs_$get_uid_file (Dinfo_.seg (i).dir, sinfo_name, uid, code); 1694 /* - Is block divider name also external name? */ 1695 /* We already know the info seg's uid. */ 1696 if uid ^= Dinfo_.seg (i).uid then 1697 go to NAME_MISMATCH; /* - It is not. */ 1698 end; 1699 go to BLOCK_MATCHES; 1700 1701 NAME_MISMATCH: end CHECK_BLOCK_NAMES; 1702 1703 go to NEXT_BLOCK; /* None of names on this block match input spec */ 1704 1705 %page; 1706 BLOCK_MATCHES: 1707 if ^some_block_foundS then do; /* k = i: overwrite original Dinfo_(i) element. */ 1708 /* with data specific to matching block. */ 1709 k = i; 1710 some_block_foundS = T; 1711 end; 1712 else do; /* Already overwrote Dinfo_(i) element, so create a new */ 1713 /* one to hold data specific to 2nd...Nth matching blocks*/ 1714 k, Dinfo_.N = Dinfo_.N + 1; /* - This new entry is NOT examined by later */ 1715 /* iterations thru EXAMINE_INFO_SEG do-group. */ 1716 /* See NOTE at that label - above. */ 1717 Dinfo_.seg (k) = Dinfo_.seg (i); /* - copy data from original Dinfo_.item(i) to */ 1718 end; /* new Dinfo_.item(k) structure. */ 1719 1720 if ^info_path.S.separate_info_name then 1721 Dinfo_.seg (k).ent = sinfo_name; /* - In case of starname, use this block name as */ 1722 /* name by which phys. info seg was found. */ 1723 Dinfo_.seg (k).date = block_date; /* - Use date in block header line as date modified */ 1724 /* for this block. */ 1725 1726 Dinfo_.seg (k).I = charno (iBlok.P); /* - Save offset of block text w/in info seg so we can */ 1727 /* later identify (perhaps recreated) iBlok structure */ 1728 /* for this block. */ 1729 /* charno gives 0-based offset w/in info of 1st char */ 1730 /* of block. (iBlok.P points to :Info: divider token).*/ 1731 1732 Dinfo_.seg (k).L = length (Blok); /* length of block content (including any divider) */ 1733 1734 Dinfo_.seg (k).info_name = Blok_names (j); /* Name by which block was selected in CHECK_BLOCK_NAMES */ 1735 /* do-group above. */ 1736 1737 if ^(info_path.S.starname_info_name | info_path.S.separate_info_name) then 1738 go to NEXT_INFO_SEG; /* If condition true, only one block can match input spec */ 1739 1740 NEXT_BLOCK: end CHECK_BLOCKS; 1741 1742 if ^some_block_foundS then 1743 NO_BLOCK_MATCHES: 1744 do; 1745 if info_path.S.starname_info_name then 1746 Dinfo_.seg (i).code = error_table_$nomatch; 1747 else Dinfo_.seg (i).code = error_table_$noentry; 1748 end NO_BLOCK_MATCHES; 1749 1750 go to NEXT_INFO_SEG; 1751 1752 %page; 1753 INFO_STRUCTURE (iFile_structure_INFO_SUBROUTINE_HCOM): /* Subroutine Info Seg... */ 1754 /* to be treated in Dinfo_.seg list as a single block; */ 1755 /* but info_seg_ treats each :Entry: as a separate block.*/ 1756 iBlokP = iFile.bloks.lastP; 1757 if iBlokP ^= null () then /* - Unthread history comment block from list */ 1758 if iBlok.divider = iBlok_divider_hcom | iBlok.divider = iBlok_divider_hcom_obsolete then do; 1759 call info_seg_$unthread_iBlok (iBlokP); 1760 Dinfo_.seg (k).L = Dinfo_.seg (k).L - length (Blok); 1761 end; /* - Remove HCom length from length of total info seg */ 1762 /* Blok starts at divider, and includes rest of block */ 1763 1764 INFO_STRUCTURE (iFile_structure_INFO_SUBROUTINE): /* Subroutine Info Seg without History Comment... */ 1765 INFO_STRUCTURE (iFile_structure_SUBROUTINE): 1766 go to NEXT_INFO_SEG; /* - Entire info segment (minus history comment) */ 1767 /* is the block to be displayed. */ 1768 1769 1770 INFO_STRUCTURE (iFile_structure_NO_DIVIDERS): /* Info Segment without blocks... */ 1771 go to NEXT_INFO_SEG; /* - Entire info segment is selected for display. */ 1772 1773 1774 BLOCKS_error: 1775 if Dinfo_.seg (i).code ^= 0 then do; 1776 Dinfo_.seg (i).uid = "0"b; /* If error occurred during processing, mark */ 1777 Dinfo_.seg (i).I = 0; /* info to cause error message to be printed. */ 1778 Dinfo_.seg (i).E = ""; 1779 end; 1780 1781 NEXT_INFO_SEG: 1782 end EXAMINE_INFO_SEG; 1783 return; 1784 1785 %page; 1786 free_dir_list: /* Free storage allocated by hcs_$star_dir_list */ 1787 proc (); 1788 1789 if star_list_names_ptr ^= null () then 1790 free star_list_names in (hi_area); 1791 if star_list_branch_ptr ^= null () then 1792 free star_dir_list_branch in (hi_area); 1793 1794 end free_dir_list; 1795 %page; 1796 %include star_structures; 1797 %page; 1798 %include status_structures; 1799 1800 dcl 1 branch aligned like status_branch; 1801 1802 end get_info_seg_list; 1803 1804 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1805 %page; 1806 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1807 1808 numeric_date: 1809 procedure (bit_date) returns (fixed bin (71)); 1810 /* This procedure converts a file system date */ 1811 /* to a numeric clock value. A file system date */ 1812 /* is the high-order 36 bits of a 52 bit clock */ 1813 /* value. */ 1814 1815 dcl bit_date bit (36) unal, 1816 num_date fixed bin (71); 1817 1818 1819 num_date = 0; 1820 substr (unspec (num_date), 21, 36) = bit_date; 1821 return (num_date); 1822 1823 end numeric_date; 1824 1825 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1826 %page; 1827 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1828 /* */ 1829 /* ENTRYPOINT: help_$init */ 1830 /* */ 1831 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1832 1833 init: 1834 entry (procedure_name, search_list_name, search_list_ref_dir, Vrequired, Phelp_args, Acode); 1835 1836 dcl search_list_name char (*), /* Name of search list used in finding infos. (input) */ 1837 search_list_ref_dir char (*), /* Referencing dir used in search rules. (input) */ 1838 Vrequired fixed bin; /* Required version of help_args structure. (input) */ 1839 1840 Phelp_args = null(); /* Initial values for our output arguments. */ 1841 Acode = 0; 1842 1843 if Vrequired ^= Vhelp_args_3 & Vrequired ^= 2 & Vrequired ^= 1 then do; 1844 Acode = error_table_$unimplemented_version; /* Complain if requested version unknown to this code. */ 1845 return; 1846 end; 1847 1848 /* ----------------------------------------------------------------- 1849 Create the help_ ssu_ subsystem. 1850 ----------------------------------------------------------------- */ 1851 1852 dcl my_sciP ptr; 1853 dcl NO_INFO_DIRECTORY char (0) int static options(constant) init(""); 1854 dcl NO_REQUEST_TABLE ptr int static options(constant) init(null()); 1855 dcl NULL_INFO_PTR ptr int static options(constant) init(null()); 1856 1857 my_sciP = null(); /* Prepare to cleanup ssu_ invocation if stack unwound */ 1858 on cleanup call init_janitor (my_sciP, Phelp_args); /* before help_$init returns to caller. */ 1859 1860 call ssu_$create_invocation (procedure_name, HELP_VERSION_02, NULL_INFO_PTR, NO_REQUEST_TABLE, 1861 NO_INFO_DIRECTORY, my_sciP, Acode); /* help_ now runs in its own ssu_ subsystem. */ 1862 if Acode ^= 0 then 1863 return; 1864 1865 /* ----------------------------------------------------------------- 1866 Get temporary segment (from ssu_) to hold help_args structure 1867 (and lots of other structures). 1868 ----------------------------------------------------------------- */ 1869 1870 dcl HELP_ARGS_COMMENT char (9) int static options(constant) init("help_args"); 1871 1872 call ssu_$get_temp_segment (my_sciP, HELP_ARGS_COMMENT, Phelp_args); 1873 /* Obtain a temporary segment: storage zeroed because */ 1874 /* $get_temp_segment truncates segment to 0-length and */ 1875 /* new pages added to segment are all zeros. */ 1876 1877 /* ----------------------------------------------------------------- 1878 Initialize 1st structure stored in temp segment: help_info (hi) 1879 - The help_info structure is declared in: _help_shared_data_.incl.pl1 1880 NOTE: Elements in help_info, their attributes, and overall size 1881 of help_info structure do not change, no matter how often the 1882 help_$help_ entry point is called. 1883 ----------------------------------------------------------------- */ 1884 1885 help_infoP = Phelp_args; /* help_info (hi) begins at base of temp seg (Position 1) */ 1886 1887 call ssu_$set_info_ptr (my_sciP, help_infoP); /* Make addr(help_info) the ssu_ info_ptr passed to each */ 1888 /* help_ response program. */ 1889 1890 hi.init_ptrs = null(); /* Initialize help_info elements that are not zeroes: */ 1891 hi.help_ptrs = null(); /* - .help_numbers, .help_video_data, .help_switches */ 1892 hi.help_video_data.video_iocbP = null(); /* are already zeroed by ssu_$get_temp_segment. */ 1893 hi.info_ptrs = null(); 1894 hi.help_labels = INIT_FAILED; 1895 1896 1897 dcl HELP_AREA_IS_STANDARD_AREA ptr int static options(constant) init(null()); 1898 dcl HELP_AREA_TAG char (19) int static options(constant) init("help_ standard area"); 1899 1900 call ssu_$get_area (my_sciP, HELP_AREA_IS_STANDARD_AREA, HELP_AREA_TAG, hi.areaP); 1901 /* - .areaP points to area w/ "standard characteristics" */ 1902 1903 1904 hi.sciP = my_sciP; /* - .sciP points to help_'s ssu_ invocation. */ 1905 1906 1907 hi.init_ptrs.next_free_spaceP = help_infoP; /* - Free space in temp seg begins at base of segment. */ 1908 1909 call set_space_used (currentsize (hi) ); /* - Record length of help_info (hi) structure as */ 1910 /* "used space" in the temp segment. */ 1911 1912 1913 1914 /* ----------------------------------------------------------------- 1915 Initialize 2nd structure stored in temp segment: info_seg_data (isd) 1916 - The info_seg_data structure is declared in: info_seg_dcls_.incl.pl1 1917 It is the structure passed among info_seg_$XXX entrypoints. 1918 ----------------------------------------------------------------- */ 1919 1920 dcl 1 isd aligned like info_seg_data based (hi.isdP); 1921 1922 hi.isdP = hi.next_free_spaceP; /* info_seg_data (isd) is next in temp seg (Position 2) */ 1923 isd.version = info_seg_data_version_01; /* - help_ calls info_seg_$initialize w/ this structure. */ 1924 isd.standalone_invocationS = F; 1925 isd.ptrs = null(); 1926 isd.relatives = null(); 1927 1928 isd.sciP = hi.sciP; /* - share help_'s ssu_ subsystem for errors, etc. */ 1929 isd.std_areaP = hi.areaP; /* - share help_'s standard allocation area. */ 1930 1931 call set_space_used (currentsize (isd)); /* Record length of info_seg_data (isd) structures as */ 1932 /* "used space" in the temp segment. */ 1933 1934 /* ----------------------------------------------------------------- 1935 Initialize 3rd structure stored in temp segment: help_args 1936 - The help_args structure is declared in: help_args_.incl.pl1 1937 ----------------------------------------------------------------- */ 1938 1939 hi.help_argsP, Phelp_args = hi.next_free_spaceP; /* help_args structure is next in temp seg (Position 3) */ 1940 1941 help_args.version = Vrequired; /* - Initialize other parts of help_args. */ 1942 help_args.Sctl = "0"b; 1943 help_args.Npaths = 0; 1944 help_args.Ncas = 0; 1945 help_args.Nsrhs = 0; 1946 help_args.min_Lpgh = INFO_LINES_PER_PARAGRAPH; 1947 help_args.max_Lpgh = get_page_length_$switch (null(), code); 1948 /* - Show more help output without prompting. */ 1949 help_args.Lspace_between_infos = INFO_BLANK_LINES_BEFORE_PARAGRAPH; 1950 help_args.min_date_time = -1; /* - Selection of only infos modified after given time */ 1951 /* is disabled by default. */ 1952 1953 help_args.sci_ptr = null(); /* - help_ no longer refers to these pointers. Any */ 1954 help_args.help_data_ptr = null(); /* caller-provided ssu_ subsystem is ignored. */ 1955 1956 /* ----------------------------------------------------------------- 1957 - Get list of search paths in which help_ will look for 1958 info segments. 1959 - cleanup on-unit above releases all allocated storage. (The 1960 entire hi_area is released by ssu_$destroy_invocation.) 1961 - Save list in: help_args.Nsearch_dirs and .search_dirs 1962 ----------------------------------------------------------------- */ 1963 1964 if search_list_name ^= "" then do; /* - Initialize info_segment search paths. */ 1965 call search_paths_$get (search_list_name, sl_control_default, search_list_ref_dir, null(), addr(hi_area), 1966 sl_info_version_1, sl_info_p, Acode); 1967 if Acode = 0 then do; 1968 help_args.Nsearch_dirs = sl_info.num_paths; /* Copy search paths to: help_args.search_dirs(*) */ 1969 if help_args.Nsearch_dirs > 0 then 1970 help_args.search_dirs (*) = sl_info.paths (*).pathname; 1971 free sl_info in (hi_area); /* Free search_ paths_$get allocated storage. */ 1972 end; 1973 else help_args.Nsearch_dirs = 0; /* - Failed to find named search paths. */ 1974 end; 1975 else help_args.Nsearch_dirs = 0; /* - No search_paths name given? Disable search paths*/ 1976 1977 call set_space_used (currentsize (help_args)); /* Record length of help_args structure as "used space" */ 1978 /* in the temp segment. But caller will change size of */ 1979 /* by adding .path array elements. */ 1980 /* help_ recalculates this value each time it is called. */ 1981 1982 /* ----------------------------------------------------------------- 1983 At this point, help_args is fully initialized. 1984 - From this point on, our caller is responsible for calling 1985 help_$term if stack is unwound; no need to explicitly 1986 revert cleanup condition; return statement does that. 1987 ----------------------------------------------------------------- */ 1988 1989 return; /* Return to caller of help_$init. */ 1990 1991 INIT_FAILED: 1992 call init_janitor (my_sciP, Phelp_args); 1993 return; 1994 1995 1996 init_janitor: 1997 proc (AsciP, Ahelp_argsP); 1998 1999 dcl (AsciP, Ahelp_argsP) ptr; 2000 2001 if AsciP ^= null() then 2002 call ssu_$destroy_invocation (AsciP); /* - Destroy help_ ssu_ subsystem. */ 2003 Ahelp_argsP = null(); /* - Set caller's Phelp_args pointer to null so caller */ 2004 /* does not try to call help_$term before help_args */ 2005 /* has been initialized. */ 2006 end init_janitor; 2007 2008 2009 %page; 2010 %include "_help_shared_data_"; 2011 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 2012 %page; 2013 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2014 /* */ 2015 /* ENTRYPOINT: help_$term */ 2016 /* */ 2017 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2018 2019 term: 2020 entry (procedure_name, Phelp_args, Acode); 2021 2022 Acode = 0; /* Set output parameter (which is never used). */ 2023 2024 if Phelp_args = null then /* If pointer to help_args structure still null, then */ 2025 return; /* nothing to terminate. */ 2026 2027 help_infoP = ptr (Phelp_args, 0); /* Access hidden help_info structure at base of temp seg */ 2028 2029 if hi.isdP ^= null() then /* Terminate any info segments remaining initiated; and */ 2030 call info_seg_$terminate (addr(isd)); /* release no-free areas created by info_seg_. */ 2031 2032 2033 dcl needsDestruction bit(1) aligned; 2034 2035 needsDestruction = (hi.sciP ^= null); /* Destroy help_ ssu_ subsystem. */ 2036 call standalone_cleanup_handler (needsDestruction, hi.sciP); 2037 /* This routine is in: ssu_invoker_dcls_.incl.pl1 */ 2038 2039 Phelp_args = null(); /* NOTE: The above call also releases the temp seg */ 2040 /* pointed to by Phelp_args. */ 2041 return; 2042 2043 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2044 %page; 2045 %include arg_list; 2046 %page; 2047 %include help_args_; 2048 %page; 2049 %include help_cis_args_; 2050 %page; 2051 %include access_mode_values; 2052 %page; 2053 %include sl_info; 2054 2055 %include sl_control_s; 2056 %page; 2057 %include ssu_invoker_dcls_; 2058 %page; 2059 %include ssu_prompt_modes; 2060 %page; 2061 %include system_constants; 2062 2063 end help_;