1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1988                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1981 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 
 14 
 15 /****^  HISTORY COMMENTS:
 16   1) change(86-01-21,LJAdams), approve(86-01-21,MCR7327),
 17      audit(86-04-17,Lippard), install(86-04-24,MR12.0-1048):
 18      Added ssu_ references so subsytem call to help_ work properly.  Added
 19      include file "help_args" which contains the new version number for help.
 20   2) change(88-08-03,RWaters), approve(88-08-03,MCR7950),
 21      audit(88-09-29,Huen), install(88-10-07,MR12.2-1146):
 22      Bug fixes for MR12.2.
 23                                                    END HISTORY COMMENTS */
 24 
 25 
 26 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16            */
 27 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo       */
 28 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend   */
 29 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt   */
 30 
 31 tedhelp_: proc (rstr);
 32 
 33 dcl rstr            char (*);
 34 
 35 /* UPDATE HISTORY                                                            */
 36 /* EL#   date       TR        comments                                       */
 37 /* 143 84-10-10 phx17314 "help <info> -about <topic>" == "help <info>"       */
 38 /* modified April, 1985 by L. Adams - use new help_args_ incl file           */
 39 /* 202 88-07-08 phx20819 sci_ptr must be set to null()                       */
 40 
 41 %include help_args_;
 42 %include tedcommon_;
 43 dcl 1 buf_des, 2 des;                   /* These 2 lines are to fulfill      */
 44 dcl 1 seg_des, 2 des;                   /* ..refs in tedcommon.              */
 45 %page;
 46 dcl about_sw        bit (1);
 47 dcl err_ct          fixed bin;
 48 dcl error_table_$badopt fixed bin (35) ext static;
 49 dcl error_table_$nomatch fixed bin (35) ext static;
 50 dcl first_rule_p    ptr;
 51 dcl i               fixed bin;
 52 dcl me              char (8) int static init ("ted_help");
 53 dcl msg             char (168) var;
 54 dcl code            fixed bin (35);
 55 dcl msg_sw          bit (1);
 56 dcl bar_info        bit (1);
 57 dcl progress        fixed bin;
 58                                         /* =1: bad help_args version         */
 59                                         /* =2: no pathnames given.           */
 60                                         /* =3: evaluating pathnames.         */
 61                                         /* =4: finding help segs.            */
 62                                         /* =5: -section/-search              */
 63                                         /*     & printing help segs.         */
 64 dcl rstr_b          fixed bin;
 65 dcl sci_ptr         ptr;
 66 dcl sec_sw          bit (1);
 67 dcl state           fixed bin;
 68 dcl tp              ptr;
 69 dcl dname           char (168);
 70 dcl command_error   condition;
 71 
 72 dcl com_err_        entry options (variable);
 73 dcl convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35));
 74 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*),
 75                     fixed bin (35));
 76 dcl hcs_$make_ptr   entry (ptr, char (*), char (*), ptr, fixed bin (35));
 77 dcl hcs_$status_minf entry (char(*), char(*), fixed bin(1), fixed bin(2),
 78                     fixed bin(24), fixed bin(35));
 79 dcl ioa_            entry options (variable);
 80 
 81 dcl ssu_$destroy_invocation             entry (ptr),
 82     ssu_$standalone_invocation          entry (ptr, char(*), char(*), ptr, entry, fixed bin(35));
 83 
 84 
 85 dcl (addr, codeptr, index, length, null, rtrim, string, substr, verify
 86     ) builtin;
 87 
 88 dcl cleanup                              condition;
 89 
 90 
 91       call help_$init (me, "info", "", Vhelp_args_3, Phelp_args, code);
 92       if (code ^= 0)
 93       then call com_err_ (code, me, "init");
 94 
 95       help_args.Sctl.title = "1"b;
 96       help_args.Lspace_between_infos = 1;
 97       bar_info = "0"b;
 98       help_args.min_Lpgh = 2;
 99       help_args.Npaths = 1;
100       help_args.path (1).value = "ted";
101       string (help_args.path (1).S) = "0"b;
102       help_args.dir (1, 1) = "";
103       help_args.ent (1) = "";
104       help_args.S (1).info_name_not_starname = "1"b;
105 /* RW 88 */
106       help_args.sci_ptr = null;                                       /*#202*/
107 
108 xxxxx: first_rule_p = codeptr (xxxxx);  /* get pointer to me                 */
109       rstr_b = verify (rstr, " ");      /* skip any leading SP               */
110       msg_sw, about_sw, sec_sw = "0"b;
111       state = 1;
112 
113 /* .   1       2       3       4       5       6       7 <-- STATE           */
114 /* .   |func   info    section -about  topic   -from X                       */
115 /* . Expected combinations:                                                  */
116 /* .           info                                                          */
117 /* .           info    section                                               */
118 /* .           **      section                                               */
119 /* .                           -about  topic                                 */
120 /* .                                           -from X                       */
121 /* .           **      section                 -from X                       */
122 /* .   |func                                                                 */
123 /* .   |func   info                                                          */
124 /* .   |info                   -about  topic                                 */
125 /* .   -msg    xxx)etc                                                       */
126 
127       do while (rstr_b < length (rstr));
128          i = index (substr (rstr, rstr_b), " ");
129          if (i = 0)
130          then i = length (rstr) - rstr_b;
131          else i = i - 1;
132          if (i > 1)
133          then do;
134             if (substr (rstr, rstr_b, 1) = "|")
135             then do;
136                if (state ^= 1)
137                then do;
138                   msg = "External function name must be first.";
139                   goto err_ret;
140                end;
141                call find_external_info;
142                bar_info = "1"b;
143                state = 2;
144                goto update;
145             end;
146             if (substr (rstr, rstr_b, i) = "-msg")
147             then do;
148                if (state = 1)
149                then do;
150                   help_args.title = "0"b;
151                   msg_sw = "1"b;
152                   help_args.path (1).value = "ted_msgs";
153                   state = 2;
154                   goto update;
155                end;
156             end;
157             if (substr (rstr, rstr_b, i) = "-about")
158             then do;
159                help_args.title = "0"b;                                /* #143*/
160                if (state < 3)
161                then do;
162                   help_args.info_name (1) = "**";
163                   help_args.S (1).info_name_not_starname = "0"b;
164                   about_sw = "1"b;
165                   state = 5;
166                   goto update;
167                end;
168                if (state < 5)
169                then do;
170                   state = 5;
171                   goto update;
172                end;
173                msg = "Misplaced -about.";
174                goto err_ret;
175             end;
176             if (substr (rstr, rstr_b, i) = "-from")
177             then do;
178                if (state = 5)
179                then do;
180                   msg = "-from cannot follow -about.";
181                   goto err_ret;
182                end;
183                if (state = 1)
184                then do;
185                   help_args.Sctl.he_only = "1"b;
186                   help_args.Sctl.he_info_name = "1"b;
187                   help_args.Sctl.he_counts = "1"b;
188                   help_args.info_name (1) = "**";
189                   help_args.S (1).info_name_not_starname = "0"b;
190                end;
191                rstr_b = rstr_b + i;
192                i = length (rstr) - rstr_b;
193                msg = substr (rstr, rstr_b, i);
194                call convert_date_to_binary_ ((msg),
195                   help_args.min_date_time, code);
196                if (code ^= 0)
197                then goto err_ret;
198                goto update;
199             end;
200             if (substr (rstr, rstr_b, 1) = "-")
201             then do;
202                msg = substr (rstr, rstr_b, i);
203                code = error_table_$badopt;
204                goto err_ret;
205             end;
206          end;
207          if (state < 3)
208          then do;
209             help_args.info_name (1) = substr (rstr, rstr_b, i);
210             if (help_args.info_name (1) = "**")
211             then help_args.info_name_not_starname (1) = "0"b;
212             state = 3;
213             if msg_sw
214             then if (i > 5)
215                  then if (substr (help_args.info_name (1), 5, 1) = "|")
216                       then do;          /* external function error           */
217                          rstr_b = rstr_b + 4;
218                          i = i - 4;
219                          call find_external_info;
220 
221 /* The form here is                                                          */
222 /*      -msg xxx)|yyyy                                                       */
223 /* The action to be done is to search for ted_yyyy_ and then use the         */
224 /*  directory containing it as the search directory. The segment looked for  */
225 /*  is ted_yyyy_.info.  The info looked for is "xxx)|yyyy". If that is not   */
226 /*  found, then "xxx)" is looked for.                                        */
227 
228                       end;
229             goto update;
230          end;
231          if (state = 3)
232          then do;
233             help_args.title = "0"b;
234             help_args.Sctl.scn, sec_sw = "1"b;
235             help_args.Nscns = 1;
236             help_args.scn (1) = substr (rstr, rstr_b, i);
237             state = 4;
238             goto update;
239          end;
240          if (state = 5)
241          then do;
242             help_args.Nsrhs = 1;
243             help_args.Sctl.srh = "1"b;
244             i = length (rstr) - rstr_b;
245             help_args.srh = substr (rstr, rstr_b, i);
246             goto update;
247          end;
248          msg = "Improper arguments.";
249 err_ret:
250          call com_err_ (code, me, "^a", msg);
251          goto return_;
252 update:
253          rstr_b = rstr_b + i;
254          rstr_b = rstr_b - 1 + verify (substr (rstr, rstr_b), " ");
255                                         /* skip any leading SP               */
256       end;
257 
258 
259       on condition (command_error) begin;
260 dcl 1 command_error_info aligned based (cond_info.infoptr),
261       2 length      fixed bin,
262       2 version     fixed bin init (2),
263       2 action_flags,
264         3 cant_restart bit (1) unal,
265         3 default_restart bit (1) unal,
266         3 reserved  bit (34) unal,
267       2 info_string char (256) var,
268       2 status_code fixed bin (35),
269       2 name_p      ptr,
270       2 name_l      fixed bin,
271       2 msg_p       ptr,
272       2 msg_l       fixed bin,
273       2 msg_maxl    fixed bin,
274       2 print_sw    bit (1);
275 dcl 1 cond_info     aligned,
276 %include cond_info;
277 dcl find_condition_info_ entry (ptr, ptr, fixed bin (35));
278 
279             call find_condition_info_ (null (), addr (cond_info), code);
280             if (code = 0)
281             then do;
282                command_error_info.print_sw = "0"b;
283                err_ct = err_ct + 1;
284             end;
285 
286          end;
287 dcl l fixed bin;
288       call hcs_$fs_get_path_name (first_rule_p, dname, l, "", code);
289       if (code ^= 0)
290       then do;
291          call com_err_ (code, me, "Getting pathname from ^p", first_rule_p);
292          goto return_;
293       end;
294       call hcs_$status_minf (dname, help_args.path (1).value || ".info",
295          0, 0, 0, code);
296       if (code = 0)                     /* if name was found, use that'un    */
297       then help_args.path (1).value
298          = rtrim (dname) || ">" || help_args.path (1).value;
299 
300 re_help:
301       err_ct = 0;
302       sci_ptr = null;
303 
304       on cleanup
305          begin;
306          if Phelp_args ^= null then
307             call ssu_$destroy_invocation (help_args.sci_ptr);
308          else if sci_ptr ^= null then
309             call ssu_$destroy_invocation (sci_ptr);
310          end;
311 
312       call ssu_$standalone_invocation (sci_ptr, me, (ted_vers), null, abort_help_command, code);
313       if code ^= 0 then
314          call com_err_ (code, me, "Unable to invoke ssu.");
315 
316       help_args.sci_ptr = sci_ptr;
317 
318       call help_ (me, Phelp_args, "info", progress, code);
319       if (err_ct > 0) & msg_sw
320       then do;
321          if (substr (help_args.info_name (1), 4, 1) = ")")
322          then do;
323             substr (help_args.info_name (1), 4) = "";
324             goto re_help;
325          end;
326          call ioa_ ("No additional help available.^/");
327          code = 0;
328       end;
329       if (code ^= 0)
330       then do;
331          if (progress = 3)
332          then code = help_args.path (1).code;
333          if (progress = 5) & (sec_sw | about_sw) & (err_ct = 0)
334          then call ioa_ (
335                  "^[^; Info ""^a"" does not contain section ""^a"""
336                  || "^[ (in ^a)^]^/^]", about_sw, help_args.info_name (1),
337                  help_args.scn (1), bar_info, help_args.search_dirs (1));
338          else if (progress = 4)
339          then call ioa_ ("Info segment not found. ^a.info",
340                  help_args.value (1));
341          else do;
342             if (code = error_table_$nomatch)
343             then call ioa_ ("No info found. ^a^[ (in ^a)^]",
344                     help_args.info_name (1), bar_info, help_args.search_dirs (1));
345             else call com_err_ (code, me);
346          end;
347       end;
348 
349 return_:
350       if Phelp_args ^= null then
351          call ssu_$destroy_invocation (help_args.sci_ptr);
352       else if sci_ptr ^= null then
353          call ssu_$destroy_invocation (sci_ptr);
354       call help_$term (me, Phelp_args, 0);
355       return;
356 
357 
358 abort_help_command:
359       proc;
360 
361       return;
362 end abort_help_command;
363 
364 
365 find_external_info: proc;
366       help_args.value (1) = "ted_";
367       help_args.info_name (1) = "";
368       help_args.value (1)
369          = help_args.value (1) || substr (rstr, rstr_b + 1, i - 1);
370       help_args.value (1) = help_args.value (1) || "_";
371 
372       call hcs_$make_ptr (first_rule_p, (help_args.value (1)),
373          (help_args.value (1)), tp, code);
374       if (code ^= 0)
375       then do;
376          call com_err_ (code, me, "Searching for ^a",
377             help_args.value (1));
378          goto return_;
379       end;
380       first_rule_p = tp;
381    end;
382 
383    end tedhelp_;