win/sysmgr.w

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI ADM1
   2 &ANALYZE-RESUME
   3 &Scoped-define WINDOW-NAME W-Win
   4 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS W-Win
   5 /*------------------------------------------------------------------------
   6   File:         win/winmgr.w
   7   Description:  System window manager
   8 ------------------------------------------------------------------------*/
   9 CREATE WIDGET-POOL.
  10 /* ***************************  Definitions  ************************** */
  11
  12 &SCOPED-DEFINE MAX-WINS 200
  13 &SCOPED-DEFINE GAP      8
  14
  15 &SCOPED-DEFINE MAX-X    1280
  16 &SCOPED-DEFINE MAX-Y    1024
  17
  18 DEF VAR root       AS HANDLE NO-UNDO.
  19 DEF VAR pool-name  AS CHAR INITIAL "MANAGER" NO-UNDO.
  20
  21 &GLOB MAXIMUM-BUTTONS 50
  22 DEF VAR btn        AS HANDLE EXTENT {&MAXIMUM-BUTTONS} NO-UNDO.
  23 DEF VAR n          AS INT INIT 0 NO-UNDO.
  24
  25 DEF VAR max-x AS INT NO-UNDO.
  26 DEF VAR max-y AS INT NO-UNDO.
  27
  28 {inc/ofc-this.i}
  29 {inc/ofc-set-l.i "Focus-Parent-On-Close" "focus-parent-on-close"}
  30 IF NOT AVAILABLE(OfficeSetting) THEN focus-parent-on-close = Yes.
  31
  32 DEF VAR window-title-prefix AS CHAR NO-UNDO INITIAL ?.
  33 DEF VAR system-description AS CHAR NO-UNDO INITIAL ?.
  34 DEF VAR window-icon-file AS CHAR NO-UNDO INITIAL ?.
  35 DEF VAR menu-bitmap-file AS CHAR NO-UNDO INITIAL ?.
  36 DEF VAR last-drawn AS HANDLE NO-UNDO.
  37 DEF VAR user-name  AS CHAR NO-UNDO.
  38
  39 RUN initialise.
  40
  41 DEFINE TEMP-TABLE MyUG NO-UNDO LIKE UsrGroup.
  42
  43 DEFINE TEMP-TABLE Node NO-UNDO
  44   FIELD proc-hdl  AS HANDLE
  45   FIELD vwr-hdl   AS HANDLE
  46   FIELD frm-hdl   AS HANDLE
  47   FIELD node-code LIKE LinkNode.NodeCode
  48   FIELD btn-hdl   AS HANDLE
  49   FIELD link-list AS CHAR
  50   FIELD context   AS CHAR
  51
  52   INDEX proc-hdl IS UNIQUE PRIMARY
  53     proc-hdl
  54
  55   INDEX vwr-hdl IS UNIQUE
  56     vwr-hdl
  57
  58   INDEX Context
  59     node-code
  60     context
  61
  62   INDEX node-code
  63     node-code.
  64
  65 DEFINE TEMP-TABLE Link NO-UNDO
  66   LIKE ProgramLink
  67   FIELD src-hdl  AS HANDLE
  68   FIELD dst-hdl  AS HANDLE
  69   FIELD btn-hdl  AS HANDLE
  70   FIELD fil-hdl  AS HANDLE
  71   FIELD cde-hdl  AS HANDLE
  72   FIELD link-id  AS CHAR
  73
  74   INDEX btn-hdl IS UNIQUE PRIMARY
  75     btn-hdl
  76
  77   INDEX fil-hdl IS UNIQUE
  78     fil-hdl
  79
  80   INDEX link-code
  81     LinkCode
  82
  83   INDEX src-hdl
  84     src-hdl
  85
  86   INDEX link-id
  87     src-hdl
  88     link-id.
  89
  90 DEF BUFFER RL FOR Link. /* Buffer used when processing (running a link)
  91                            Avoids incorrect Link buffer re-reads */
  92
  93 /******************* Triggers which apply _anywhere_ ****************/
  94 ON F3 ANYWHERE DO:
  95   RUN expand-autotext .
  96 END.
  97
  98 ON F5 ANYWHERE DO:
  99   RUN refresh-current-browser .
 100 END.
 101
 102 ON CTRL-ALT-F10 ANYWHERE DO:
 103   RUN win/d-andrew.w NO-ERROR.
 104 END.
 105
 106 /* _UIB-CODE-BLOCK-END */
 107 &ANALYZE-RESUME
 108
 109
 110 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
 111
 112 /* ********************  Preprocessor Definitions  ******************** */
 113
 114 &Scoped-define PROCEDURE-TYPE SmartWindow
 115 &Scoped-define DB-AWARE no
 116
 117 &Scoped-define ADM-CONTAINER WINDOW
 118
 119 /* Name of first Frame and/or Browse and/or first Query                 */
 120 &Scoped-define FRAME-NAME F-Main
 121
 122 /* Custom List Definitions                                              */
 123 /* List-1,List-2,List-3,List-4,List-5,List-6                            */
 124
 125 /* _UIB-PREPROCESSOR-BLOCK-END */
 126 &ANALYZE-RESUME
 127
 128
 129 /* ************************  Function Prototypes ********************** */
 130
 131 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD extract-attribute W-Win
 132 FUNCTION extract-attribute RETURNS CHARACTER
 133   ( INPUT attribute-list AS CHAR, INPUT attribute-name AS CHAR )  FORWARD.
 134
 135 /* _UIB-CODE-BLOCK-END */
 136 &ANALYZE-RESUME
 137
 138 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-window-program W-Win
 139 FUNCTION get-window-program RETURNS HANDLE
 140   ( INPUT window-hdl AS WIDGET-HANDLE )  FORWARD.
 141
 142 /* _UIB-CODE-BLOCK-END */
 143 &ANALYZE-RESUME
 144
 145 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-window-title W-Win
 146 FUNCTION get-window-title RETURNS CHARACTER
 147   ( /* parameter-definitions */ )  FORWARD.
 148
 149 /* _UIB-CODE-BLOCK-END */
 150 &ANALYZE-RESUME
 151
 152 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD link-running W-Win
 153 FUNCTION link-running RETURNS LOGICAL
 154   ( OUTPUT window-title AS CHAR )  FORWARD.
 155
 156 /* _UIB-CODE-BLOCK-END */
 157 &ANALYZE-RESUME
 158
 159 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD unique-db-identifier W-Win
 160 FUNCTION unique-db-identifier RETURNS CHARACTER
 161   ( /* parameter-definitions */ )  FORWARD.
 162
 163 /* _UIB-CODE-BLOCK-END */
 164 &ANALYZE-RESUME
 165
 166
 167 /* ***********************  Control Definitions  ********************** */
 168
 169 /* Define the widget handle for the window                              */
 170 DEFINE VAR W-Win AS WIDGET-HANDLE NO-UNDO.
 171
 172 /* ************************  Frame Definitions  *********************** */
 173
 174 DEFINE FRAME F-Main
 175     WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
 176          SIDE-LABELS NO-UNDERLINE THREE-D
 177          AT COL 1 ROW 1
 178          SCROLLABLE SIZE 320 BY 320.
 179
 180
 181 /* *********************** Procedure Settings ************************ */
 182
 183 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 184 /* Settings for THIS-PROCEDURE
 185    Type: SmartWindow
 186    Allow: Basic,Browse,DB-Fields,Query,Smart,Window
 187    Other Settings: COMPILE
 188  */
 189 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 190
 191 /* *************************  Create Window  ************************** */
 192
 193 &ANALYZE-SUSPEND _CREATE-WINDOW
 194 IF SESSION:DISPLAY-TYPE = "GUI":U THEN
 195   CREATE WINDOW W-Win ASSIGN
 196          HIDDEN             = YES
 197          TITLE              = "SYSMGR"
 198          HEIGHT             = 8.4
 199          WIDTH              = 54.86
 200          MAX-HEIGHT         = 200
 201          MAX-WIDTH          = 200
 202          VIRTUAL-HEIGHT     = 200
 203          VIRTUAL-WIDTH      = 200
 204          RESIZE             = no
 205          SCROLL-BARS        = no
 206          STATUS-AREA        = no
 207          BGCOLOR            = ?
 208          FGCOLOR            = ?
 209          KEEP-FRAME-Z-ORDER = yes
 210          THREE-D            = yes
 211          MESSAGE-AREA       = no
 212          SENSITIVE          = yes.
 213 ELSE {&WINDOW-NAME} = CURRENT-WINDOW.
 214
 215 &IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
 216 IF NOT W-Win:LOAD-ICON("BITMAPS\capital":U) THEN
 217     MESSAGE "Unable to load icon: BITMAPS\capital"
 218             VIEW-AS ALERT-BOX WARNING BUTTONS OK.
 219 &ENDIF
 220 /* END WINDOW DEFINITION                                                */
 221 &ANALYZE-RESUME
 222
 223 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB W-Win
 224 /* ************************* Included-Libraries *********************** */
 225
 226 {src/adm/method/containr.i}
 227 {inc/method/m-sysmgr.i}
 228 {inc/method/m-utils.i}
 229 {inc/string.i}
 230
 231 /* _UIB-CODE-BLOCK-END */
 232 &ANALYZE-RESUME
 233
 234
 235
 236
 237 /* ***********  Runtime Attributes and AppBuilder Settings  *********** */
 238
 239 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
 240 /* SETTINGS FOR WINDOW W-Win
 241   VISIBLE,,RUN-PERSISTENT                                               */
 242 /* SETTINGS FOR FRAME F-Main
 243                                                                         */
 244 ASSIGN
 245        FRAME F-Main:HEIGHT           = 38
 246        FRAME F-Main:WIDTH            = 146.29.
 247
 248 IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(W-Win)
 249 THEN W-Win:HIDDEN = yes.
 250
 251 /* _RUN-TIME-ATTRIBUTES-END */
 252 &ANALYZE-RESUME
 253
 254
 255
 256
 257
 258 /* ************************  Control Triggers  ************************ */
 259
 260 &Scoped-define SELF-NAME W-Win
 261 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL W-Win W-Win
 262 ON END-ERROR OF W-Win /* SYSMGR */
 263 OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO:
 264   /* This case occurs when the user presses the "Esc" key.
 265      In a persistently run window, just ignore this.  If we did not, the
 266      application would exit. */
 267   IF THIS-PROCEDURE:PERSISTENT THEN RETURN NO-APPLY.
 268 END.
 269
 270 /* _UIB-CODE-BLOCK-END */
 271 &ANALYZE-RESUME
 272
 273
 274 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL W-Win W-Win
 275 ON WINDOW-CLOSE OF W-Win /* SYSMGR */
 276 DO:
 277   /* This ADM code must be left here in order for the SmartWindow
 278      and its descendents to terminate properly on exit. */
 279
 280   /* hiding the root window makes the exit look tidier */
 281   DEF VAR root-window AS HANDLE NO-UNDO.
 282   root-window = {&WINDOW-NAME}:HANDLE .
 283   /* root-window = root:CURRENT-WINDOW. */
 284   root-window:HIDDEN = Yes.
 285
 286   RUN kill-children( root ).
 287   APPLY 'CLOSE':U TO root.
 288   APPLY 'CLOSE':U TO THIS-PROCEDURE.
 289   RETURN NO-APPLY.
 290 END.
 291
 292 /* _UIB-CODE-BLOCK-END */
 293 &ANALYZE-RESUME
 294
 295
 296 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL W-Win W-Win
 297 ON WINDOW-MAXIMIZED OF W-Win /* SYSMGR */
 298 DO:
 299   {&WINDOW-NAME}:WINDOW-STATE = WINDOW-NORMAL.
 300 END.
 301
 302 /* _UIB-CODE-BLOCK-END */
 303 &ANALYZE-RESUME
 304
 305
 306 &UNDEFINE SELF-NAME
 307
 308 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK W-Win
 309
 310
 311 /* ***************************  Main Block  *************************** */
 312
 313 /* Include custom  Main Block code for SmartWindows. */
 314 {src/adm/template/windowmn.i}
 315
 316 ASSIGN
 317   {&WINDOW-NAME}:WIDTH-P  = 1
 318   {&WINDOW-NAME}:HEIGHT-P = 1
 319   {&WINDOW-NAME}:X = SESSION:WIDTH-PIXELS
 320   {&WINDOW-NAME}:Y = {&GAP}
 321   {&WINDOW-NAME}:TITLE = window-title-prefix + user-name + " - " + PDBNAME(1) + " - Window Manager".
 322
 323 RUN resize-frame IN THIS-PROCEDURE( {&MAX-X}, {&MAX-Y} ).
 324
 325 RUN set-window-icon( {&WINDOW-NAME} ).
 326
 327 SESSION:MULTITASKING-INTERVAL = 20.
 328 {&WINDOW-NAME}:KEEP-FRAME-Z-ORDER = focus-parent-on-close.
 329
 330 /* _UIB-CODE-BLOCK-END */
 331 &ANALYZE-RESUME
 332
 333
 334 /* **********************  Internal Procedures  *********************** */
 335
 336 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE add-node W-Win
 337 PROCEDURE add-node :
 338 /*------------------------------------------------------------------------------
 339   Purpose:
 340 ------------------------------------------------------------------------------*/
 341 DEF INPUT PARAMETER proc-hdl  AS HANDLE NO-UNDO.
 342
 343   DEF BUFFER ThisNode FOR Node.
 344
 345   IF NOT VALID-HANDLE( proc-hdl ) OR
 346      CAN-FIND( ThisNode WHERE ThisNode.Proc-hdl = proc-hdl ) THEN RETURN.
 347   IF NOT VALID-HANDLE( root ) THEN root = proc-hdl.
 348
 349
 350   DEF VAR frm-hdl   AS HANDLE NO-UNDO.
 351   DEF VAR proc-name AS CHAR   NO-UNDO.
 352
 353   RUN get-attribute IN proc-hdl( 'frame-handle' ) NO-ERROR.
 354   frm-hdl   = WIDGET-HANDLE( RETURN-VALUE ).
 355   RUN get-attribute IN proc-hdl( 'FileName' ) NO-ERROR.
 356   proc-name = RETURN-VALUE.
 357
 358   FIND LinkNode WHERE LinkNode.File = proc-name NO-LOCK NO-ERROR.
 359
 360   CREATE ThisNode.
 361   ASSIGN
 362     ThisNode.proc-hdl  = proc-hdl
 363     ThisNode.frm-hdl   = frm-hdl
 364     ThisNode.node-code = IF AVAILABLE LinkNode THEN LinkNode.NodeCode ELSE ?.
 365
 366   IF AVAILABLE LinkNode AND LinkNode.NodeType <> "MV" THEN
 367   DO:
 368     RUN create-link-objects( proc-hdl ).
 369     RUN create-button ( ThisNode.proc-hdl, OUTPUT ThisNode.btn-hdl ).
 370     IF proc-hdl = root THEN RUN redraw IN THIS-PROCEDURE.
 371   END.
 372
 373   RUN get-links( proc-hdl, OUTPUT ThisNode.link-list ).
 374
 375 END PROCEDURE.
 376
 377 /* _UIB-CODE-BLOCK-END */
 378 &ANALYZE-RESUME
 379
 380 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects W-Win  _ADM-CREATE-OBJECTS
 381 PROCEDURE adm-create-objects :
 382 /*------------------------------------------------------------------------------
 383   Purpose:     Create handles for all SmartObjects used in this procedure.
 384                After SmartObjects are initialized, then SmartLinks are added.
 385   Parameters:  <none>
 386 ------------------------------------------------------------------------------*/
 387
 388 END PROCEDURE.
 389
 390 /* _UIB-CODE-BLOCK-END */
 391 &ANALYZE-RESUME
 392
 393 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available W-Win  _ADM-ROW-AVAILABLE
 394 PROCEDURE adm-row-available :
 395 /*------------------------------------------------------------------------------
 396   Purpose:     Dispatched to this procedure when the Record-
 397                Source has a new row available.  This procedure
 398                tries to get the new row (or foriegn keys) from
 399                the Record-Source and process it.
 400   Parameters:  <none>
 401 ------------------------------------------------------------------------------*/
 402
 403   /* Define variables needed by this internal procedure.             */
 404   {src/adm/template/row-head.i}
 405
 406   /* Process the newly available records (i.e. display fields,
 407      open queries, and/or pass records on to any RECORD-TARGETS).    */
 408   {src/adm/template/row-end.i}
 409
 410 END PROCEDURE.
 411
 412 /* _UIB-CODE-BLOCK-END */
 413 &ANALYZE-RESUME
 414
 415 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apms-system-manager W-Win
 416 PROCEDURE apms-system-manager :
 417 /*------------------------------------------------------------------------------
 418   Purpose:
 419   Parameters:  <none>
 420   Notes:
 421 ------------------------------------------------------------------------------*/
 422
 423   /* DO NOT DELETE THIS PROCEDURE !!!!!! */
 424   /* IT IS USED TO IDENTIFY THIS PERSISTENT PROCEDURE AS
 425      THE SYSTEM MANAGER */
 426
 427 END PROCEDURE.
 428
 429 /* _UIB-CODE-BLOCK-END */
 430 &ANALYZE-RESUME
 431
 432 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE back-tab W-Win
 433 PROCEDURE back-tab :
 434 /*------------------------------------------------------------------------------
 435   Purpose:
 436   Parameters:  <none>
 437   Notes:
 438 ------------------------------------------------------------------------------*/
 439
 440   APPLY 'BACK-TAB':U TO SELF.
 441
 442 END PROCEDURE.
 443
 444 /* _UIB-CODE-BLOCK-END */
 445 &ANALYZE-RESUME
 446
 447 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-rights W-Win
 448 PROCEDURE check-rights :
 449 /*------------------------------------------------------------------------------
 450   Purpose:
 451 ------------------------------------------------------------------------------*/
 452 DEF INPUT PARAMETER application AS CHAR NO-UNDO.
 453 DEF INPUT PARAMETER action AS CHAR NO-UNDO.
 454
 455 DEF VAR rights AS LOGICAL NO-UNDO.
 456
 457   RUN get-rights IN THIS-PROCEDURE( application, action, OUTPUT rights).
 458   IF rights THEN RETURN.
 459
 460   /* NOT rights */
 461   MESSAGE "You do not have sufficient access rights." SKIP(1)
 462           "Please contact your system administrator"
 463           VIEW-AS ALERT-BOX WARNING
 464           TITLE "No Rights to " + action + " in " + application.
 465   RETURN "FAIL".
 466
 467 END PROCEDURE.
 468
 469 /* _UIB-CODE-BLOCK-END */
 470 &ANALYZE-RESUME
 471
 472 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE create-button W-Win
 473 PROCEDURE create-button :
 474 /*------------------------------------------------------------------------------
 475   Purpose:
 476 ------------------------------------------------------------------------------*/
 477 DEF INPUT PARAMETER  proc-hdl AS HANDLE NO-UNDO.
 478 DEF OUTPUT PARAMETER btn-hdl  AS HANDLE NO-UNDO.
 479
 480   DEF VAR proc-win AS HANDLE NO-UNDO.
 481   /* proc-win = proc-hdl:CURR-WINDOW. */
 482   RUN get-window-handle IN proc-hdl NO-ERROR.
 483   proc-win = WIDGET-HANDLE( RETURN-VALUE ).
 484
 485   n = n + 1.
 486   IF n > {&MAXIMUM-BUTTONS} THEN DO:
 487     MESSAGE "Maximum buttons exceeded!" SKIP(1)
 488             "How can you cope with all of those on the screen?" SKIP
 489             "I recommend you close some windows!"
 490             VIEW-AS ALERT-BOX ERROR.
 491     RETURN.
 492   END.
 493
 494   DEF VAR btn-label AS CHAR NO-UNDO.
 495   btn-label = proc-win:TITLE.
 496   IF btn-label = "" THEN
 497     btn-label = "Capital APMS".
 498   IF SUBSTRING( btn-label, 1, LENGTH(window-title-prefix)) = window-title-prefix THEN
 499     btn-label = SUBSTRING( btn-label, LENGTH(window-title-prefix) + 1).
 500
 501 DO WITH FRAME {&FRAME-NAME}:
 502   CREATE BUTTON btn[ n ]
 503     ASSIGN
 504       X            = 1
 505       Y            = 1
 506       FONT         = 15
 507       LABEL        = btn-label
 508       PRIVATE-DATA = STRING( proc-hdl )
 509       FRAME        = FRAME {&FRAME-NAME}:HANDLE
 510       HIDDEN       = Yes
 511
 512     TRIGGERS:
 513       ON CHOOSE PERSISTENT RUN focus-from-button IN THIS-PROCEDURE.
 514       ON 'CURSOR-UP':U,   'CURSOR-LEFT':U  PERSISTENT RUN back-tab IN THIS-PROCEDURE.
 515       ON 'CURSOR-DOWN':U, 'CURSOR-RIGHT':U PERSISTENT RUN fwd-tab  IN THIS-PROCEDURE.
 516     END TRIGGERS.
 517
 518   RUN crop-button( btn[ n ] ).
 519
 520   proc-hdl:PRIVATE-DATA = STRING( btn[n]:HANDLE ).
 521   btn-hdl = btn[ n ].
 522 END.
 523
 524 END PROCEDURE.
 525
 526 /* _UIB-CODE-BLOCK-END */
 527 &ANALYZE-RESUME
 528
 529 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE create-link-objects W-Win
 530 PROCEDURE create-link-objects :
 531 /*------------------------------------------------------------------------------
 532   Purpose:
 533 ------------------------------------------------------------------------------*/
 534 DEF INPUT PARAMETER proc-hdl AS HANDLE NO-UNDO.
 535
 536   DEF BUFFER ThisLink FOR Link.
 537
 538   RUN get-attribute IN proc-hdl ( 'LinkId' ).
 539   FIND ThisLink WHERE ROWID( ThisLink ) = TO-ROWID( RETURN-VALUE ) NO-ERROR.
 540
 541   /* Link Object exit conditions */
 542   IF NOT AVAILABLE ThisLink OR LOOKUP( ThisLink.LinkType, "MSG" ) <> 0 THEN RETURN.
 543
 544   /***********************************************
 545
 546     Instantiate and link all link objects
 547     relevant to the given procedure object
 548
 549    ***********************************************/
 550
 551   DEF VAR opt-pnl AS HANDLE NO-UNDO.
 552   DEF BUFFER Src FOR Node. FIND Src WHERE Src.proc-hdl = ThisLink.src-hdl.
 553   DEF BUFFER Dst FOR Node. FIND Dst WHERE Dst.proc-hdl = ThisLink.dst-hdl.
 554
 555
 556   IF ThisLink.CreateViewer AND TRIM(ThisLink.Viewer) <> "" THEN DO: /* Create the viewer */
 557     DEF VAR vwr-name AS CHAR NO-UNDO.
 558     RUN verify-prog( ThisLink.Viewer, OUTPUT vwr-name ).
 559     IF RETURN-VALUE <> "FAIL" THEN
 560       RUN init-object IN ThisLink.dst-hdl ( vwr-name, Dst.frm-hdl, "", OUTPUT Dst.vwr-hdl ).
 561   END.
 562
 563   RUN set-attribute-list IN ThisLink.dst-hdl ( "Viewer = " +
 564     IF VALID-HANDLE( Dst.vwr-hdl) THEN STRING( Dst.vwr-hdl ) ELSE ThisLink.Viewer ).
 565   RUN get-viewer IN ThisLink.dst-hdl( OUTPUT Dst.vwr-hdl ).
 566   RUN set-attribute-list IN Dst.vwr-hdl( ThisLink.Function ).
 567   IF RL.LinkType = "SEL" THEN DO:
 568     DEF VAR ctr-hdl AS CHAR NO-UNDO.
 569     RUN get-link-handle IN adm-broker-hdl ( Src.proc-hdl, 'CONTAINER-SOURCE', OUTPUT ctr-hdl ).
 570     RUN set-attribute-list IN Dst.vwr-hdl( "Source-Window = " + ctr-hdl ).
 571     RUN set-attribute-list IN Dst.vwr-hdl( "Source-Viewer = " + STRING(Src.proc-hdl) ).
 572   END.
 573   ELSE
 574     RUN set-attribute-list IN Dst.vwr-hdl( "Source-Viewer = " + STRING(Src.vwr-hdl) ).
 575
 576   RUN get-attribute IN Dst.vwr-hdl( "SortPanel" ).
 577   IF ThisLink.SortPanel OR RETURN-VALUE = "Yes" THEN    /* Create a Sort Panel */
 578   DO:
 579     RUN init-object IN ThisLink.dst-hdl ( 'panel/p-option.w':U, Dst.frm-hdl,
 580       'Style = Horizontal Radio-Set, Label = Sort By, Style-Attribute = SortBy-Style,
 581        Link-Name = SortBy-Target, Options-Attribute = SortBy-Options, Case-Attribute = SortBy-case':U,
 582        OUTPUT opt-pnl ).
 583     RUN add-link IN adm-broker-hdl ( opt-pnl, 'SortBy':U, Dst.vwr-hdl ).
 584     RUN dispatch IN opt-pnl ( 'Initialize':U ).
 585     RUN set-attribute-list IN ThisLink.dst-hdl( 'SortBy-Panel = ' + STRING( opt-pnl ) ).
 586   END.
 587
 588   RUN get-attribute IN Dst.vwr-hdl( "FilterPanel" ).
 589   IF ThisLink.FilterPanel OR RETURN-VALUE = "Yes" THEN    /* Create a Filter Panel */
 590   DO:
 591     RUN init-object IN ThisLink.dst-hdl ( 'panel/p-option.w':U, Dst.frm-hdl,
 592       'Style = Horizontal Radio-Set, Label = Filter By, Style-Attribute = FilterBy-Style,
 593        Link-Name = FilterBy-Target, Options-Attribute = FilterBy-Options, Case-Attribute = FilterBy-Case':U,
 594        OUTPUT opt-pnl ).
 595     RUN add-link IN adm-broker-hdl ( opt-pnl, 'FilterBy':U, Dst.vwr-hdl ).
 596     RUN dispatch IN opt-pnl ( 'Initialize':U ).
 597     RUN set-attribute-list IN ThisLink.dst-hdl( 'FilterBy-Panel = ' + STRING( opt-pnl ) ).
 598   END.
 599
 600   RUN get-attribute IN Dst.vwr-hdl( "OptionPanel" ).
 601   IF RETURN-VALUE <> ? AND RETURN-VALUE <> "" THEN DO:
 602     /* Create a generic Option Panel */
 603     DEF VAR panel-name AS CHAR NO-UNDO.
 604     panel-name = RETURN-VALUE.
 605     RUN init-object IN ThisLink.dst-hdl ( 'panel/p-option.w':U, Dst.frm-hdl,
 606       'Style = Horizontal Radio-Set, Label = ' + panel-name + ', Style-Attribute = ' + panel-name + '-Style,
 607        Link-Name = ' + panel-name + '-Target, Options-Attribute = ' + panel-name + '-Options, Case-Attribute = ' + panel-name + '-case':U,
 608        OUTPUT opt-pnl ).
 609     RUN add-link IN adm-broker-hdl ( opt-pnl, panel-name, Dst.vwr-hdl ).
 610     RUN dispatch IN opt-pnl ( 'Initialize':U ).
 611     RUN set-attribute-list IN ThisLink.dst-hdl( 'Option-Panel = ' + STRING( opt-pnl ) + ", " + panel-name + " = " + STRING( opt-pnl ) ).
 612   END.
 613
 614   RUN get-attribute IN Dst.vwr-hdl( "SearchPanel" ).
 615   IF RETURN-VALUE = "Yes" THEN    /* Create a Search Panel */
 616   DO:
 617     RUN init-object IN ThisLink.dst-hdl ( 'panel/p-search.w':U, Dst.frm-hdl,
 618       'Label = Search for, Link-Name = SearchBy-Target, Value-Attribute = SearchBy-Case':U,
 619        OUTPUT opt-pnl ).
 620     RUN add-link IN adm-broker-hdl ( opt-pnl, 'SearchBy':U, Dst.vwr-hdl ).
 621     RUN dispatch IN opt-pnl ( 'Initialize':U ).
 622     RUN set-attribute-list IN ThisLink.dst-hdl( 'SearchBy-Panel = ' + STRING( opt-pnl ) ).
 623   END.
 624
 625   RUN get-attribute IN Dst.vwr-hdl( "AlphabetPanel" ).
 626   IF RETURN-VALUE = "Yes" THEN    /* Create an Alphabet Panel */
 627   DO:
 628     RUN init-object IN ThisLink.dst-hdl ( 'panel/p-abc.w':U, Dst.frm-hdl,
 629             'Button-Font = 9, Dispatch-Open-Query = yes, Margin-Pixels = 0,
 630              Edge-Pixels = 0':U, OUTPUT opt-pnl ).
 631     RUN add-link IN adm-broker-hdl ( opt-pnl, 'Filter':U, Dst.vwr-hdl ).
 632     RUN dispatch IN opt-pnl ( 'Initialize':U ).
 633     RUN set-attribute-list IN ThisLink.dst-hdl( 'Filter-Panel = ' + STRING( opt-pnl ) ).
 634   END.
 635
 636   RUN get-attribute IN Dst.vwr-hdl( "AlphabetPanel2" ).
 637   IF RETURN-VALUE = "Yes" THEN    /* Create a second Alphabet Panel */
 638   DO:
 639     RUN init-object IN ThisLink.dst-hdl ( 'panel/p-abc2.w':U, Dst.frm-hdl,
 640             'Button-Font = 9, Dispatch-Open-Query = yes, Margin-Pixels = 0,
 641              Edge-Pixels = 0':U, OUTPUT opt-pnl ).
 642     RUN add-link IN adm-broker-hdl ( opt-pnl, 'Filter2':U, Dst.vwr-hdl ).
 643     RUN dispatch IN opt-pnl ( 'Initialize':U ).
 644     RUN set-attribute-list IN ThisLink.dst-hdl( 'Filter2-Panel = ' + STRING( opt-pnl ) ).
 645   END.
 646
 647   RUN get-attribute IN Dst.vwr-hdl( "NotesViewer" ).
 648   IF RETURN-VALUE = "Yes" THEN
 649   DO:
 650     RUN init-object IN ThisLink.dst-hdl ( 'vwr/mnt/v-note.w':U, Dst.frm-hdl,
 651             'Font = 10':U, OUTPUT opt-pnl ).
 652     RUN add-link IN adm-broker-hdl ( Dst.vwr-hdl, 'RECORD':U, opt-pnl ).
 653     RUN dispatch IN opt-pnl ( 'Initialize':U ).
 654     RUN set-attribute-list IN ThisLink.dst-hdl( 'Notes-Handle = ' + STRING( opt-pnl ) ).
 655   END.
 656
 657   /****** BEGIN Experiment for linking objects ******/
 658
 659   DEF VAR i AS INT NO-UNDO.
 660   DEF VAR j AS INT NO-UNDO.
 661   DEF VAR direction  AS CHAR NO-UNDO.
 662   DEF VAR parameters AS CHAR NO-UNDO.
 663   DEF VAR link-type  AS CHAR NO-UNDO.
 664   DEF VAR attribute  AS CHAR NO-UNDO.
 665   DEF VAR object     AS CHAR NO-UNDO.
 666   DEF VAR object-hdl AS HANDLE NO-UNDO.
 667
 668   DO i = 1 TO 2:
 669     direction = ( IF i = 1 THEN "From" ELSE "To" ).
 670     DO j = 1 TO 3:
 671       attribute = "Link-" + direction + "-" + STRING( j ).
 672       RUN get-attribute IN Dst.vwr-hdl( attribute ).
 673       parameters = RETURN-VALUE.
 674       IF parameters <> ? THEN DO:
 675         object     = ENTRY( 1, parameters, "|" ).
 676         link-type  = ENTRY( 2, parameters, "|" ).
 677         RUN init-object IN ThisLink.dst-hdl ( object, Dst.frm-hdl,' ' , OUTPUT object-hdl ).
 678         IF direction <> "To" THEN direction = "From".
 679         IF direction = "To" THEN
 680           RUN add-link IN adm-broker-hdl ( Dst.vwr-hdl, link-type, object-hdl ).
 681         ELSE
 682           RUN add-link IN adm-broker-hdl ( object-hdl, link-type, Dst.vwr-hdl ).
 683         RUN dispatch IN object-hdl ( 'Initialize':U ).
 684         RUN set-attribute-list IN ThisLink.dst-hdl( attribute + " = " + STRING( object-hdl ) ).
 685       END.
 686     END.
 687   END.
 688
 689   /****** END Experiment for linking objects ******/
 690
 691   /* Link the viewers */
 692
 693   IF LOOKUP( ThisLink.LinkType, "DRL,MNT" ) <> 0 THEN DO:
 694     IF VALID-HANDLE( Src.vwr-hdl ) AND Src.proc-hdl <> Src.vwr-hdl AND
 695        VALID-HANDLE( Dst.vwr-hdl ) THEN
 696       RUN add-link IN adm-broker-hdl ( Src.vwr-hdl, 'RECORD':U, Dst.vwr-hdl ).
 697   END.
 698
 699 END PROCEDURE.
 700
 701 /* _UIB-CODE-BLOCK-END */
 702 &ANALYZE-RESUME
 703
 704 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE crop-button W-Win
 705 PROCEDURE crop-button :
 706 /*------------------------------------------------------------------------------
 707   Purpose:
 708   Parameters:  <none>
 709   Notes:
 710 ------------------------------------------------------------------------------*/
 711
 712   DEF INPUT PARAMETER h-btn AS HANDLE NO-UNDO.
 713
 714   h-btn:HEIGHT-PIXELS = h-btn:HEIGHT-PIXELS - 6.
 715   h-btn:WIDTH-PIXELS  = h-btn:WIDTH-PIXELS + 4.
 716
 717 END PROCEDURE.
 718
 719 /* _UIB-CODE-BLOCK-END */
 720 &ANALYZE-RESUME
 721
 722 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI W-Win  _DEFAULT-DISABLE
 723 PROCEDURE disable_UI :
 724 /*------------------------------------------------------------------------------
 725   Purpose:     DISABLE the User Interface
 726   Parameters:  <none>
 727   Notes:       Here we clean-up the user-interface by deleting
 728                dynamic widgets we have created and/or hide
 729                frames.  This procedure is usually called when
 730                we are ready to "clean-up" after running.
 731 ------------------------------------------------------------------------------*/
 732   /* Delete the WINDOW we created */
 733   IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(W-Win)
 734   THEN DELETE WIDGET W-Win.
 735   IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
 736 END PROCEDURE.
 737
 738 /* _UIB-CODE-BLOCK-END */
 739 &ANALYZE-RESUME
 740
 741 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-link W-Win
 742 PROCEDURE each-link :
 743 /*------------------------------------------------------------------------------
 744   Purpose:
 745 ------------------------------------------------------------------------------*/
 746 DEF INPUT PARAMETER attribs AS CHAR NO-UNDO.
 747
 748   DEF VAR i       AS INT  NO-UNDO.
 749   DEF VAR setting AS CHAR NO-UNDO.
 750   DEF VAR attrib  AS CHAR NO-UNDO.
 751   DEF VAR val     AS CHAR NO-UNDO.
 752
 753   DO i = 1 TO NUM-ENTRIES( attribs ):
 754     setting = ENTRY( i, attribs ).
 755     attrib  = TRIM( ENTRY( 1, setting, "=" ) ).
 756     val     = TRIM( SUBSTR( setting, INDEX( setting, "=" ) + 1 ) ).
 757
 758     CASE attrib:
 759       WHEN "HIDDEN"       THEN Link.btn-hdl:HIDDEN = val = "Yes".
 760       WHEN "SENSITIVE"    THEN Link.btn-hdl:SENSITIVE = val = "Yes".
 761       WHEN "FILTER-PANEL" THEN Link.FilterPanel = val = "Yes".
 762       WHEN "SORT-PANEL"   THEN Link.SortPanel = val = "Yes".
 763       WHEN "FUNCTION"     THEN Link.Function = REPLACE( val, "~n", "," ).
 764       WHEN "VIEWER"       THEN Link.Viewer   = val.
 765       WHEN "TARGET"       THEN DO:
 766       DEF BUFFER LN FOR LinkNode.
 767         FIND LN WHERE LN.File = val NO-LOCK NO-ERROR.
 768         IF AVAILABLE(LN) THEN Link.Target = LN.NodeCode.
 769       END.
 770     END CASE.
 771
 772   END.
 773
 774 END PROCEDURE.
 775
 776 /* _UIB-CODE-BLOCK-END */
 777 &ANALYZE-RESUME
 778
 779 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-program-link W-Win
 780 PROCEDURE each-program-link :
 781 /*------------------------------------------------------------------------------
 782   Purpose:
 783 ------------------------------------------------------------------------------*/
 784 DEF INPUT PARAMETER button-label AS CHAR NO-UNDO.
 785 DEF INPUT-OUTPUT PARAMETER link-list AS CHAR NO-UNDO.
 786
 787   CREATE Link.
 788   BUFFER-COPY ProgramLink TO Link ASSIGN Link.src-hdl = Node.proc-hdl.
 789
 790   IF LinkNode.NodeType = "MV" THEN DO:
 791     RUN find-sibling ( Node.frm-hdl, Link.FillName, OUTPUT Link.fil-hdl ).
 792     RUN find-sibling ( Node.frm-hdl, Link.CodeName, OUTPUT Link.cde-hdl ).
 793     ASSIGN Link.link-id = STRING( Link.fil-hdl ) .
 794   END.
 795   ELSE IF Link.LinkType = "MSG" THEN
 796     Link.Link-Id = extract-attribute( Link.Function, 'Message' ).
 797   ELSE DO:
 798     Link.Link-Id = extract-attribute( Link.Function, 'Link-Id' ).
 799     IF Link.Link-Id = "" THEN Link.Link-ID = extract-attribute( Link.Function, 'Mode' ).
 800     IF Link.Link-Id = "" THEN Link.Link-Id = Link.ButtonLabel.
 801   END.
 802
 803   IF ( LinkNode.NodeType = "MV" AND VALID-HANDLE( Link.fil-hdl ) ) OR
 804      LinkNode.NodeType <> "MV"
 805   THEN
 806
 807   CREATE BUTTON Link.btn-hdl
 808   ASSIGN
 809     FRAME        = Node.frm-hdl
 810     X            = 0
 811     Y            = 0
 812     FONT         = IF LinkNode.NodeType = "MV" THEN 16  ELSE 9
 813     LABEL        = IF LinkNode.NodeType = "MV" THEN "F" ELSE button-label
 814     PRIVATE-DATA = ""
 815     TOOLTIP      = ProgramLink.Description
 816     HIDDEN       = Yes
 817     SENSITIVE    = Yes
 818
 819   TRIGGERS:
 820     ON CHOOSE PERSISTENT RUN run-link IN THIS-PROCEDURE.
 821   END TRIGGERS.
 822
 823   IF LinkNode.NodeType = "MV" THEN  /* Position the button in the viewer */
 824   DO:
 825
 826     DEF VAR x-off AS INT NO-UNDO. DEF VAR y-off AS INT NO-UNDO.
 827     DEF VAR width AS INT NO-UNDO. DEF VAR height AS INT NO-UNDO.
 828
 829     IF NOT VALID-HANDLE(Link.btn-hdl) THEN DO:
 830       MESSAGE "Invalid Button" Link.FillName Link.CodeName "on" LinkNode.Description "Link"
 831                     VIEW-AS ALERT-BOX TITLE "Invalid Link Button".
 832       NEXT.
 833     END.
 834     Link.btn-hdl:HEIGHT-PIXELS = Link.fil-hdl:HEIGHT-PIXELS.
 835     Link.btn-hdl:WIDTH-PIXELS  = Link.btn-hdl:HEIGHT-PIXELS.
 836
 837     IF Link.fil-hdl:label = ? THEN DO:
 838       Link.btn-hdl:X = Link.fil-hdl:X - Link.btn-hdl:WIDTH-PIXELS - 2.
 839       IF Link.btn-hdl:MOVE-BEFORE-TAB-ITEM( Link.fil-hdl ) THEN.
 840     END.
 841     ELSE DO:
 842       Link.fil-hdl:WIDTH-PIXELS = Link.fil-hdl:WIDTH-PIXELS -
 843                                   Link.btn-hdl:WIDTH-PIXELS.
 844       Link.btn-hdl:X = Link.fil-hdl:X + Link.fil-hdl:WIDTH-PIXELS.
 845       IF Link.btn-hdl:MOVE-AFTER-TAB-ITEM( Link.fil-hdl ) THEN.
 846     END.
 847
 848     Link.btn-hdl:Y      = Link.fil-hdl:Y.
 849     Link.btn-hdl:HIDDEN = No.
 850
 851   END.
 852
 853   add-to-list( link-list, STRING( Link.btn-hdl ) ).
 854
 855 END PROCEDURE.
 856
 857 /* _UIB-CODE-BLOCK-END */
 858 &ANALYZE-RESUME
 859
 860 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI W-Win  _DEFAULT-ENABLE
 861 PROCEDURE enable_UI :
 862 /*------------------------------------------------------------------------------
 863   Purpose:     ENABLE the User Interface
 864   Parameters:  <none>
 865   Notes:       Here we display/view/enable the widgets in the
 866                user-interface.  In addition, OPEN all queries
 867                associated with each FRAME and BROWSE.
 868                These statements here are based on the "Other
 869                Settings" section of the widget Property Sheets.
 870 ------------------------------------------------------------------------------*/
 871   VIEW FRAME F-Main IN WINDOW W-Win.
 872   {&OPEN-BROWSERS-IN-QUERY-F-Main}
 873   VIEW W-Win.
 874 END PROCEDURE.
 875
 876 /* _UIB-CODE-BLOCK-END */
 877 &ANALYZE-RESUME
 878
 879 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE expand-autotext W-Win
 880 PROCEDURE expand-autotext :
 881 /*------------------------------------------------------------------------------
 882   Purpose:
 883   Parameters:  <none>
 884   Notes:
 885 ------------------------------------------------------------------------------*/
 886
 887   DEF VAR obj AS HANDLE NO-UNDO.
 888   obj = SELF.
 889
 890   IF VALID-HANDLE( obj ) AND
 891     ( obj:TYPE = "FILL-IN" OR ( obj:TYPE = "EDITOR" /* AND obj:LARGE = no */) ) THEN
 892   DO:
 893
 894     DEF VAR val   AS CHAR   NO-UNDO.
 895     DEF VAR h-prt AS HANDLE NO-UNDO.
 896     DEF VAR pos1  AS INT    NO-UNDO.
 897     DEF VAR pos2  AS INT    NO-UNDO.
 898
 899     val = obj:SCREEN-VALUE.
 900     h-prt = obj:PARENT.
 901
 902     IF h-prt:TYPE = "BROWSE" THEN pos2 = LENGTH(val) + 1.
 903                              ELSE pos2 = obj:CURSOR-OFFSET.
 904     pos1 = R-INDEX( val, " ", pos2) + 1.
 905     IF pos2 < 1 THEN pos2 = 1.
 906
 907     DEF VAR atxt-lookup LIKE AutoText.AutoTextCode NO-UNDO.
 908     atxt-lookup = SUBSTRING( val, pos1, pos2 - pos1).
 909
 910
 911     /* Try to find the autotext */
 912
 913     FIND FIRST AutoText WHERE AutoText.AutoTextCode = atxt-lookup NO-LOCK NO-ERROR.
 914
 915     IF AVAILABLE AutoText THEN DO:
 916
 917       obj:SCREEN-VALUE = SUBSTRING( val, 1, pos1 - 1) + AutoText.Description + SUBSTRING( val, pos2 + 1 ).
 918       IF h-prt:TYPE = "BROWSE" THEN APPLY "END" TO obj.
 919                                ELSE obj:CURSOR-OFFSET = pos1 + LENGTH(AutoText.Description).
 920     END.
 921     ELSE
 922     DO:
 923       MESSAGE "Couldn't find '" + atxt-lookup + "'"  VIEW-AS ALERT-BOX
 924         INFORMATION TITLE "Autotext Problem".
 925       APPLY 'ENTRY':U TO obj.
 926       IF h-prt:TYPE = "BROWSE" THEN obj:AUTO-ZAP = No.
 927                                ELSE obj:CURSOR-OFFSET = pos2.
 928     END.
 929
 930   END.
 931
 932 END PROCEDURE.
 933
 934 /* _UIB-CODE-BLOCK-END */
 935 &ANALYZE-RESUME
 936
 937 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE focus-from-button W-Win
 938 PROCEDURE focus-from-button :
 939 /*------------------------------------------------------------------------------
 940   Purpose:
 941 ------------------------------------------------------------------------------*/
 942 DEF VAR node AS HANDLE NO-UNDO.
 943
 944   FIND Node NO-LOCK WHERE Node.btn-hdl = FOCUS NO-ERROR.
 945   IF AVAILABLE Node THEN
 946     RUN focus-window IN THIS-PROCEDURE ( Node.proc-hdl ).
 947
 948 END PROCEDURE.
 949
 950 /* _UIB-CODE-BLOCK-END */
 951 &ANALYZE-RESUME
 952
 953 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE focus-parent W-Win
 954 PROCEDURE focus-parent :
 955 /*------------------------------------------------------------------------------
 956   Purpose:     Focus on the immediate parent of the given window
 957 ------------------------------------------------------------------------------*/
 958 DEF INPUT PARAMETER node AS HANDLE NO-UNDO.
 959
 960 DEF VAR par-str AS CHAR NO-UNDO.
 961 DEF VAR par     AS HANDLE NO-UNDO.
 962
 963   RUN get-link-handle IN adm-broker-hdl ( node, 'WINMGR-SOURCE':U, OUTPUT par-str ).
 964   par = WIDGET-HANDLE( ENTRY( 1, par-str ) ).
 965   RUN focus-window IN THIS-PROCEDURE ( par ).
 966
 967 END PROCEDURE.
 968
 969 /* _UIB-CODE-BLOCK-END */
 970 &ANALYZE-RESUME
 971
 972 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE focus-root W-Win
 973 PROCEDURE focus-root :
 974 /*------------------------------------------------------------------------------
 975   Purpose:
 976 ------------------------------------------------------------------------------*/
 977
 978   RUN dispatch IN root ('apply-entry':U ).
 979
 980 END PROCEDURE.
 981
 982 /* _UIB-CODE-BLOCK-END */
 983 &ANALYZE-RESUME
 984
 985 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE focus-this-button W-Win
 986 PROCEDURE focus-this-button :
 987 /*------------------------------------------------------------------------------
 988   Purpose:
 989 ------------------------------------------------------------------------------*/
 990 DEF INPUT PARAMETER proc-hdl AS HANDLE NO-UNDO.
 991
 992   IF {&WINDOW-NAME}:WINDOW-STATE = WINDOW-MINIMIZED THEN
 993      {&WINDOW-NAME}:WINDOW-STATE = WINDOW-NORMAL.
 994
 995   FIND Node WHERE Node.proc-hdl = proc-hdl NO-LOCK NO-ERROR.
 996   RUN set-idle .
 997   IF AVAILABLE Node AND VALID-HANDLE( Node.btn-hdl ) THEN
 998     APPLY 'ENTRY':U TO Node.btn-hdl.
 999   ELSE
1000     APPLY 'ENTRY':U TO btn[1].
1001
1002 END PROCEDURE.
1003
1004 /* _UIB-CODE-BLOCK-END */
1005 &ANALYZE-RESUME
1006
1007 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE focus-window W-Win
1008 PROCEDURE focus-window :
1009 /*------------------------------------------------------------------------------
1010   Purpose:
1011 ------------------------------------------------------------------------------*/
1012 DEF INPUT PARAMETER proc-hdl AS WIDGET-HANDLE NO-UNDO.
1013
1014   IF VALID-HANDLE( proc-hdl ) THEN DO:
1015     DEF VAR proc-win AS HANDLE NO-UNDO.
1016     RUN get-window-handle IN proc-hdl NO-ERROR.
1017     proc-win = WIDGET-HANDLE( RETURN-VALUE ).
1018     IF proc-win:WINDOW-STATE = WINDOW-MINIMIZED THEN
1019        proc-win:WINDOW-STATE = WINDOW-NORMAL.
1020     RUN set-idle .
1021     APPLY 'ENTRY':U TO proc-win.
1022   END.
1023
1024 END PROCEDURE.
1025
1026 /* _UIB-CODE-BLOCK-END */
1027 &ANALYZE-RESUME
1028
1029 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE fwd-tab W-Win
1030 PROCEDURE fwd-tab :
1031 /*------------------------------------------------------------------------------
1032   Purpose:
1033   Parameters:  <none>
1034   Notes:
1035 ------------------------------------------------------------------------------*/
1036
1037   APPLY 'TAB':U TO FOCUS.
1038
1039 END PROCEDURE.
1040
1041 /* _UIB-CODE-BLOCK-END */
1042 &ANALYZE-RESUME
1043
1044 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-btn-list W-Win
1045 PROCEDURE get-btn-list :
1046 /*------------------------------------------------------------------------------
1047   Purpose:
1048 ------------------------------------------------------------------------------*/
1049 DEF INPUT  PARAMETER proc-hdl AS HANDLE NO-UNDO.
1050 DEF OUTPUT PARAMETER btn-list AS CHAR NO-UNDO.
1051
1052   FIND Node NO-LOCK WHERE Node.proc-hdl = proc-hdl NO-ERROR.
1053   IF AVAILABLE Node THEN btn-list = Node.link-list.
1054
1055 END PROCEDURE.
1056
1057 /* _UIB-CODE-BLOCK-END */
1058 &ANALYZE-RESUME
1059
1060 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-links W-Win
1061 PROCEDURE get-links :
1062 /*------------------------------------------------------------------------------
1063   Purpose:  Gets and instantiates the links for a particular node
1064 ------------------------------------------------------------------------------*/
1065 DEF INPUT  PARAMETER proc-hdl  AS HANDLE NO-UNDO.
1066 DEF OUTPUT PARAMETER link-list AS CHAR   NO-UNDO.
1067
1068   DEF VAR user-name AS CHAR NO-UNDO.
1069   DEF VAR btn-list  AS CHAR NO-UNDO.
1070
1071   FIND Node NO-LOCK WHERE Node.proc-hdl = proc-hdl NO-ERROR.
1072   IF NOT AVAILABLE Node THEN RETURN.
1073
1074   FIND LinkNode WHERE LinkNode.NodeCode = Node.node-code NO-LOCK NO-ERROR.
1075   IF NOT AVAILABLE LinkNode THEN RETURN.
1076
1077   IF LinkNode.NodeType = "MV" THEN DO:
1078     FOR EACH ProgramLink NO-LOCK WHERE ProgramLink.Source = LinkNode.NodeCode:
1079       RUN each-program-link( "Lookup", INPUT-OUTPUT link-list ).
1080     END.
1081   END.
1082   ELSE DO:
1083     RUN get-username ( OUTPUT user-name ).
1084
1085     FOR EACH MyUG,
1086       FIRST UsrGroupMenu OF MyUG NO-LOCK WHERE UsrGroupMenu.NodeCode = node-code,
1087         EACH  UsrGroupMenuItem OF UsrgroupMenu NO-LOCK,
1088         FIRST ProgramLink OF UsrGroupMenuItem NO-LOCK
1089         BY MyUG.Sequence BY UsrGroupMenuItem.SequenceCode:
1090
1091       IF LOOKUP( STRING( ROWID( ProgramLink ) ), btn-list) = 0 THEN DO:
1092         btn-list = btn-list + STRING( ROWID( ProgramLink ) ) + ",".
1093         RUN each-program-link( UsrGroupMenuItem.ButtonLabel, INPUT-OUTPUT link-list ).
1094       END.
1095     END.
1096
1097   END.
1098
1099 END PROCEDURE.
1100
1101 /* _UIB-CODE-BLOCK-END */
1102 &ANALYZE-RESUME
1103
1104 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-rights W-Win
1105 PROCEDURE get-rights :
1106 /*------------------------------------------------------------------------------
1107   Purpose:
1108 ------------------------------------------------------------------------------*/
1109 DEF INPUT PARAMETER app-code AS CHAR NO-UNDO.
1110 DEF INPUT PARAMETER action AS CHAR NO-UNDO.
1111 DEF OUTPUT PARAMETER rights AS LOGICAL NO-UNDO INITIAL No.
1112
1113
1114   FIND FIRST UsrGroupMember WHERE CAN-FIND( UsrGroupRights
1115                  WHERE UsrGroupMember.GroupName = UsrGroupRights.GroupName
1116                  AND UsrGroupMember.UserName    = user-name
1117                  AND UsrGroupRights.ApplicationCode = app-code
1118                  AND UsrGroupRights.Action      = action
1119                  AND UsrGroupRights.Rights )
1120                  NO-LOCK NO-ERROR.
1121
1122   rights = AVAILABLE(UsrGroupMember).
1123
1124 END PROCEDURE.
1125
1126 /* _UIB-CODE-BLOCK-END */
1127 &ANALYZE-RESUME
1128
1129 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-system-information W-Win
1130 PROCEDURE get-system-information :
1131 /*------------------------------------------------------------------------------
1132   Purpose:  Returns system description information
1133 ------------------------------------------------------------------------------*/
1134 DEF OUTPUT PARAMETER system-abbreviation AS CHAR NO-UNDO.
1135 DEF OUTPUT PARAMETER organisation-name   AS CHAR NO-UNDO.
1136 DEF OUTPUT PARAMETER icon-filename       AS CHAR NO-UNDO.
1137 DEF OUTPUT PARAMETER menu-filename       AS CHAR NO-UNDO.
1138
1139   system-abbreviation = window-title-prefix.
1140   organisation-name = system-description.
1141   icon-filename = window-icon-file.
1142   menu-filename = menu-bitmap-file.
1143 END PROCEDURE.
1144
1145 /* _UIB-CODE-BLOCK-END */
1146 &ANALYZE-RESUME
1147
1148 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-username W-Win
1149 PROCEDURE get-username :
1150 /*------------------------------------------------------------------------------
1151   Purpose:
1152 ------------------------------------------------------------------------------*/
1153 DEF OUTPUT PARAMETER name AS CHAR NO-UNDO.
1154
1155   name = user-name.
1156
1157 END PROCEDURE.
1158
1159 /* _UIB-CODE-BLOCK-END */
1160 &ANALYZE-RESUME
1161
1162 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initialise W-Win
1163 PROCEDURE initialise :
1164 /*------------------------------------------------------------------------------
1165   Purpose:
1166 ------------------------------------------------------------------------------*/
1167
1168 {inc/username.i "user-name"}
1169   RUN set-db-identifiers.
1170
1171   FIND Usr WHERE Usr.UserName = user-name NO-LOCK NO-ERROR.
1172
1173   IF NOT AVAILABLE Usr THEN DO:
1174     MESSAGE "You are not registered for this system." SKIP
1175             "Contact your System Administrator."
1176         VIEW-AS ALERT-BOX ERROR TITLE "Invalid User - '" + user-name + "'".
1177     QUIT.
1178   END.
1179
1180   FOR EACH MyUG:    DELETE MyUG.        END.
1181   FOR EACH UsrGroup NO-LOCK WHERE CAN-FIND( FIRST UsrGroupMember OF UsrGroup WHERE UsrGroupMember.UserName = user-name ):
1182     CREATE MyUG.
1183     BUFFER-COPY UsrGroup TO MyUG.
1184   END.
1185
1186   FOR EACH Node:    DELETE Node.        END.
1187   FOR EACH Link:    DELETE Link.        END.
1188
1189 END PROCEDURE.
1190
1191 /* _UIB-CODE-BLOCK-END */
1192 &ANALYZE-RESUME
1193
1194 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE iterate-widgets W-Win
1195 PROCEDURE iterate-widgets :
1196 /*------------------------------------------------------------------------------
1197   Purpose:
1198 ------------------------------------------------------------------------------*/
1199 DEF INPUT PARAMETER wh AS WIDGET-HANDLE NO-UNDO.
1200 DEF INPUT PARAMETER proc-hdl  AS HANDLE NO-UNDO.
1201 DEF INPUT PARAMETER proc-name AS CHAR   NO-UNDO.
1202
1203   RUN VALUE( proc-name ) IN proc-hdl ( wh ) NO-ERROR.
1204   IF CAN-QUERY( wh, "FIRST-CHILD":U) AND
1205      VALID-HANDLE( wh:FIRST-CHILD ) THEN
1206     RUN iterate-widgets( wh:FIRST-CHILD, proc-hdl, proc-name ).
1207
1208   IF CAN-QUERY( wh, "NEXT-SIBLING":U) AND
1209       VALID-HANDLE( wh:NEXT-SIBLING) THEN
1210     RUN iterate-widgets( wh:NEXT-SIBLING, proc-hdl, proc-name ).
1211
1212 END PROCEDURE.
1213
1214 /* _UIB-CODE-BLOCK-END */
1215 &ANALYZE-RESUME
1216
1217 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE kill-children W-Win
1218 PROCEDURE kill-children :
1219 /*------------------------------------------------------------------------------
1220   Purpose:  Kill all windows subsidiary to the one specified
1221 ------------------------------------------------------------------------------*/
1222 DEF INPUT PARAMETER proc-hdl AS HANDLE NO-UNDO.
1223
1224 DEF VAR i        AS INT INIT 1  NO-UNDO.
1225 DEF VAR children AS CHAR        NO-UNDO.
1226 DEF VAR child    AS HANDLE      NO-UNDO.
1227
1228   RUN get-link-handle IN adm-broker-hdl ( proc-hdl, 'WINMGR-TARGET':U, OUTPUT children ).
1229
1230   DO i = 1 TO NUM-ENTRIES( children ):
1231     child = WIDGET-HANDLE( ENTRY( i, children ) ).
1232     RUN kill-children IN THIS-PROCEDURE( child ).
1233   END.
1234
1235   FOR EACH Link NO-LOCK WHERE Link.src-hdl = proc-hdl: DELETE Link. END.
1236   FIND Node NO-LOCK WHERE Node.proc-hdl = proc-hdl. DELETE Node.
1237
1238   RUN remove-button IN THIS-PROCEDURE( proc-hdl ).
1239
1240   DEF VAR proc-window AS HANDLE NO-UNDO.
1241   RUN get-window-handle IN proc-hdl NO-ERROR.
1242   proc-window = WIDGET-HANDLE( RETURN-VALUE ).
1243   proc-window:HIDDEN = Yes.
1244
1245   RUN adm-destroy   IN proc-hdl.
1246
1247 END PROCEDURE.
1248
1249 /* _UIB-CODE-BLOCK-END */
1250 &ANALYZE-RESUME
1251
1252 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-exit W-Win
1253 PROCEDURE local-exit :
1254 /* -----------------------------------------------------------
1255   Purpose:  Starts an "exit" by APPLYing CLOSE event, which starts "destroy".
1256   Parameters:  <none>
1257   Notes:    If activated, should APPLY CLOSE, *not* dispatch adm-exit.
1258 -------------------------------------------------------------*/
1259    APPLY "CLOSE":U TO THIS-PROCEDURE.
1260
1261    RETURN.
1262
1263 END PROCEDURE.
1264
1265 /* _UIB-CODE-BLOCK-END */
1266 &ANALYZE-RESUME
1267
1268 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE make-bq-entry W-Win
1269 PROCEDURE make-bq-entry :
1270 /*------------------------------------------------------------------------------
1271   Purpose:
1272 ------------------------------------------------------------------------------*/
1273 DEF INPUT PARAMETER bq-program AS CHAR NO-UNDO.
1274 DEF INPUT PARAMETER bq-params AS CHAR NO-UNDO.
1275 DEF INPUT PARAMETER bq-date AS DATE NO-UNDO.
1276 DEF INPUT PARAMETER bq-time AS INT NO-UNDO.
1277
1278 DEF VAR last-active-date AS DATE NO-UNDO.
1279 DEF VAR last-active-time AS INT NO-UNDO INITIAL -20000.
1280
1281 {inc/ofc-set.i "Batch-Queue-Enabled" "batch-queue-enabled"}
1282
1283 IF AVAILABLE(OfficeSetting) THEN DO:
1284   last-active-date = DATE( ENTRY(1,batch-queue-enabled, " ") ).
1285   last-active-time = INT( ENTRY(2,batch-queue-enabled, " ") ).
1286 END.
1287 IF last-active-date < TODAY OR last-active-time < (TIME - 180) THEN DO:
1288   RUN set-busy.
1289   RUN VALUE( bq-program ) ( bq-params ).
1290   RUN set-idle.
1291   RETURN .
1292 END.
1293
1294 DEF BUFFER BQ FOR BatchQueue.
1295 DEF VAR printer-setting AS CHAR NO-UNDO.
1296
1297   FIND RP NO-LOCK WHERE RP.UserName = user-name
1298                     AND RP.ReportID = "Current Printer" NO-ERROR.
1299
1300   IF AVAILABLE(RP) AND RP.Char4 <> "" THEN
1301     printer-setting = RP.Char4.
1302   ELSE IF AVAILABLE(RP) THEN
1303     printer-setting = RP.Char2.
1304   ELSE
1305     printer-setting = SESSION:PRINTER-PORT.
1306
1307   DO TRANSACTION:
1308     CREATE BQ.
1309     ASSIGN  BQ.RunDate        = bq-date
1310             BQ.RunTime        = bq-time
1311             BQ.RunProgram     = bq-program
1312             BQ.RunParameters  = bq-params
1313             BQ.RunStatus      = "TODO"
1314             BQ.RunOutput      = printer-setting
1315             BQ.UserName       = user-name .
1316
1317     /* now ensure we have no 'batch queue' scoped or locked */
1318     FIND FIRST BQ NO-LOCK NO-ERROR.
1319     FIND PREV BQ NO-LOCK NO-ERROR.
1320   END.
1321
1322   MESSAGE "Program Queued for Processing" SKIP "to" printer-setting VIEW-AS ALERT-BOX INFORMATION
1323           TITLE "Batch Queue".
1324
1325 END PROCEDURE.
1326
1327 /* _UIB-CODE-BLOCK-END */
1328 &ANALYZE-RESUME
1329
1330 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE rec-draw W-Win
1331 PROCEDURE rec-draw :
1332 /*------------------------------------------------------------------------------
1333   Purpose:
1334   Parameters:  <none>
1335   Notes:
1336 ------------------------------------------------------------------------------*/
1337 DEF INPUT        PARAMETER proc-hdl AS HANDLE NO-UNDO.
1338 DEF INPUT        PARAMETER x AS INT NO-UNDO.
1339 DEF INPUT-OUTPUT PARAMETER y AS INT NO-UNDO.
1340
1341   DEF VAR node-btn   AS HANDLE NO-UNDO.
1342   DEF VAR i          AS INT INIT 1 NO-UNDO.
1343   DEF VAR children   AS CHAR NO-UNDO.
1344   DEF VAR child      AS HANDLE NO-UNDO.
1345
1346   node-btn = WIDGET-HANDLE( proc-hdl:PRIVATE-DATA ).
1347   node-btn:x = x. node-btn:y = y.
1348
1349   IF VALID-HANDLE( last-drawn ) AND node-btn:MOVE-AFTER-TAB-ITEM( last-drawn ) THEN.
1350   last-drawn = node-btn.
1351
1352   RUN update-maxes IN THIS-PROCEDURE( node-btn ).
1353
1354   RUN get-link-handle IN adm-broker-hdl ( proc-hdl, 'WINMGR-TARGET', OUTPUT children ).
1355
1356   y = y + node-btn:height-pixels.
1357
1358   DO i = 1 TO NUM-ENTRIES( children ):
1359     child = WIDGET-HANDLE( ENTRY( i, children ) ).
1360     RUN rec-draw IN THIS-PROCEDURE( child, x + 20, INPUT-OUTPUT y ).
1361   END.
1362
1363 END PROCEDURE.
1364
1365 /* _UIB-CODE-BLOCK-END */
1366 &ANALYZE-RESUME
1367
1368 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE redraw W-Win
1369 PROCEDURE redraw :
1370 /*------------------------------------------------------------------------------
1371   Purpose:
1372   Parameters:  <none>
1373   Notes:
1374 ------------------------------------------------------------------------------*/
1375
1376   DEF VAR x AS INT INIT {&GAP} NO-UNDO.
1377   DEF VAR y AS INT INIT {&GAP} NO-UNDO.
1378
1379   max-x = 120.
1380   max-y = 0.
1381   last-drawn = ?.
1382
1383   HIDE FRAME {&FRAME-NAME}.
1384   RUN rec-draw IN THIS-PROCEDURE( root, x, INPUT-OUTPUT y ).
1385   RUN resize-window IN THIS-PROCEDURE( max-x , max-y ).
1386   ENABLE ALL WITH FRAME {&FRAME-NAME}.
1387
1388 END PROCEDURE.
1389
1390 /* _UIB-CODE-BLOCK-END */
1391 &ANALYZE-RESUME
1392
1393 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE refresh-current-browser W-Win
1394 PROCEDURE refresh-current-browser :
1395 /*------------------------------------------------------------------------------
1396   Purpose:
1397 ------------------------------------------------------------------------------*/
1398 DEF VAR obj AS HANDLE NO-UNDO.
1399 DEF VAR attribute-list AS CHAR NO-UNDO.
1400
1401 DEF VAR wh AS WIDGET-HANDLE NO-UNDO.
1402 DEF VAR proc-hdl  AS HANDLE NO-UNDO.
1403 DEF VAR proc-name AS CHAR   NO-UNDO.
1404
1405
1406   obj = get-window-program( CURRENT-WINDOW ).
1407
1408   IF VALID-HANDLE( obj ) THEN DO:
1409     RUN notify-viewers IN obj ( "open-query":U ).
1410   END.
1411
1412 END PROCEDURE.
1413
1414 /* _UIB-CODE-BLOCK-END */
1415 &ANALYZE-RESUME
1416
1417 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE refresh-window-title W-Win
1418 PROCEDURE refresh-window-title :
1419 /*------------------------------------------------------------------------------
1420   Purpose:     Get the description of the topic for this
1421                viewer and fix the window and button titles appropriately
1422 ------------------------------------------------------------------------------*/
1423 DEF INPUT PARAMETER proc-hdl AS WIDGET-HANDLE NO-UNDO.
1424
1425 DEF VAR proc-win AS HANDLE NO-UNDO.
1426 DEF VAR new-label AS CHAR NO-UNDO.
1427 DEF VAR rs-links AS CHAR NO-UNDO.
1428 DEF VAR i AS INT NO-UNDO.
1429 DEF VAR rs-hdl AS WIDGET-HANDLE NO-UNDO.
1430
1431   IF NOT VALID-HANDLE(proc-hdl) THEN RETURN.
1432   proc-win = proc-hdl:CURRENT-WINDOW.
1433   IF NOT VALID-HANDLE(proc-win) THEN RETURN.
1434   RUN get-link-handle IN adm-broker-hdl( proc-hdl, "record-source", OUTPUT rs-links).
1435   DO i = 1 TO NUM-ENTRIES(rs-links):
1436     rs-hdl = WIDGET-HANDLE( ENTRY( i, rs-links )).
1437     IF VALID-HANDLE(rs-hdl) THEN
1438       RUN get-topic-desc IN rs-hdl (OUTPUT new-label) NO-ERROR.
1439     IF new-label <> "" THEN LEAVE.
1440   END.
1441
1442   proc-win:TITLE = window-title-prefix + new-label.
1443
1444   RUN update-node( proc-hdl ).
1445
1446 END PROCEDURE.
1447
1448 /* _UIB-CODE-BLOCK-END */
1449 &ANALYZE-RESUME
1450
1451 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE remove-button W-Win
1452 PROCEDURE remove-button :
1453 /*------------------------------------------------------------------------------
1454   Purpose:
1455   Parameters:  <none>
1456   Notes:
1457 ------------------------------------------------------------------------------*/
1458 DEF INPUT PARAMETER proc-hdl AS HANDLE NO-UNDO.
1459
1460   DEF VAR i AS INT INIT 0 NO-UNDO.
1461   DEF VAR j AS INT NO-UNDO.
1462   DEF VAR found AS LOGI INIT No NO-UNDO.
1463
1464   /* Try to find the button */
1465
1466   DO WHILE i <= n AND NOT found:
1467     i = i + 1.
1468     found = btn[i] = WIDGET-HANDLE( proc-hdl:PRIVATE-DATA ).
1469   END.
1470
1471   IF found THEN DO:
1472     DELETE WIDGET btn[ i ].
1473     DO j = i TO n - 1:
1474       btn[ j ] = btn[ j + 1 ].
1475     END.
1476     n = n - 1.
1477   END.
1478
1479 END PROCEDURE.
1480
1481 /* _UIB-CODE-BLOCK-END */
1482 &ANALYZE-RESUME
1483
1484 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE remove-node W-Win
1485 PROCEDURE remove-node :
1486 /*------------------------------------------------------------------------------
1487   Purpose:
1488 ------------------------------------------------------------------------------*/
1489 DEF INPUT PARAMETER proc-hdl AS HANDLE NO-UNDO.
1490
1491   IF proc-hdl = root THEN DO:
1492     APPLY 'CLOSE':U TO THIS-PROCEDURE.
1493     IF uib-operational-mode THEN RETURN. ELSE QUIT.
1494   END.
1495
1496   FIND Node WHERE Node.proc-hdl = proc-hdl NO-ERROR.
1497   IF NOT AVAILABLE Node THEN RETURN.
1498   FIND LinkNode WHERE LinkNode.NodeCode = Node.node-code NO-LOCK NO-ERROR.
1499
1500   IF AVAILABLE LinkNode AND LinkNode.NodeType <> "MV" THEN DO:
1501
1502     DEF VAR par-str   AS CHAR   NO-UNDO.
1503     DEF VAR par       AS HANDLE NO-UNDO.
1504     DEF VAR par-win   AS HANDLE NO-UNDO.
1505
1506     RUN get-link-handle IN adm-broker-hdl ( proc-hdl, 'WINMGR-SOURCE':U, OUTPUT par-str ).
1507     par = WIDGET-HANDLE( ENTRY( 1, par-str ) ).
1508     IF VALID-HANDLE(par) THEN DO:
1509       IF focus-parent-on-close THEN RUN focus-this-button IN THIS-PROCEDURE ( par ).
1510       RUN get-window-handle IN par NO-ERROR.
1511       par-win = WIDGET-HANDLE( RETURN-VALUE ).
1512
1513       RUN remove-link IN adm-broker-hdl ( par, 'WINMGR', proc-hdl ).
1514       RUN kill-children IN THIS-PROCEDURE( proc-hdl ).
1515     END.
1516     RUN redraw IN THIS-PROCEDURE.
1517
1518     /* focus on the parent of the window just deleted */
1519     RUN set-idle.
1520     IF focus-parent-on-close AND VALID-HANDLE( par ) THEN DO:
1521       CURRENT-WINDOW = par-win.
1522       APPLY 'ENTRY':U TO par-win.
1523     END.
1524   END.
1525   ELSE
1526   DO:
1527     FOR EACH Link WHERE Link.src-hdl = proc-hdl: DELETE Link. END.
1528     DELETE Node.
1529   END.
1530
1531 END PROCEDURE.
1532
1533 /* _UIB-CODE-BLOCK-END */
1534 &ANALYZE-RESUME
1535
1536 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE resize-frame W-Win
1537 PROCEDURE resize-frame :
1538 /*------------------------------------------------------------------------------
1539   Purpose:
1540   Parameters:  <none>
1541   Notes:
1542 ------------------------------------------------------------------------------*/
1543
1544   DEF INPUT PARAMETER w AS INT NO-UNDO.
1545   DEF INPUT PARAMETER h AS INT NO-UNDO.
1546
1547   FRAME {&FRAME-NAME}:WIDTH-PIXELS  = w.
1548   FRAME {&FRAME-NAME}:HEIGHT-PIXELS = h.
1549
1550 END PROCEDURE.
1551
1552 /* _UIB-CODE-BLOCK-END */
1553 &ANALYZE-RESUME
1554
1555 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE resize-window W-Win
1556 PROCEDURE resize-window :
1557 /*------------------------------------------------------------------------------
1558   Purpose:
1559   Parameters:  <none>
1560   Notes:
1561 ------------------------------------------------------------------------------*/
1562 DEF INPUT PARAMETER w AS INT NO-UNDO.
1563 DEF INPUT PARAMETER h AS INT NO-UNDO.
1564
1565 DEF VAR x-from-right AS INT NO-UNDO.
1566
1567   x-from-right = ( w + {&GAP} ).
1568   IF x-from-right < 100 THEN x-from-right = 100.
1569   ASSIGN
1570     {&WINDOW-NAME}:X        = SESSION:WIDTH-PIXELS - x-from-right
1571     {&WINDOW-NAME}:Y        = {&GAP}
1572     {&WINDOW-NAME}:WIDTH-P  = w
1573     {&WINDOW-NAME}:HEIGHT-P = h.
1574
1575
1576 END PROCEDURE.
1577
1578 /* _UIB-CODE-BLOCK-END */
1579 &ANALYZE-RESUME
1580
1581 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE run-link W-Win
1582 PROCEDURE run-link :
1583 /*------------------------------------------------------------------------------
1584   Purpose:
1585 ------------------------------------------------------------------------------*/
1586
1587   DEF VAR window-title AS CHAR NO-UNDO.
1588
1589   FIND RL WHERE RL.btn-hdl = SELF. /* Jesus!! - SELF works, FOCUS doesn't !!! */
1590   RUN set-busy IN RL.src-hdl.
1591
1592   IF RL.LinkType = "MSG" THEN DO:
1593     DEF VAR message-name AS CHAR NO-UNDO.
1594     DEF BUFFER Src FOR Node.
1595     FIND Src  WHERE Src.proc-hdl = RL.src-hdl NO-LOCK.
1596     RUN dispatch IN Src.vwr-hdl ( extract-attribute( RL.Function, "MESSAGE" ) ) NO-ERROR.
1597
1598     /* Running the link may have caused the parent to close so check first */
1599     IF AVAILABLE RL AND VALID-HANDLE( RL.src-hdl ) THEN
1600       RUN set-idle IN RL.src-hdl.
1601   END.
1602   ELSE IF LOOKUP( RL.LinkType, "DRL,MNT,MNU,SEL" ) <> 0 THEN DO:
1603
1604     IF link-running( OUTPUT window-title ) THEN RETURN.
1605
1606     DEF BUFFER Dst FOR Node.
1607     DEF VAR prog-name AS CHAR NO-UNDO.
1608
1609     FIND LinkNode WHERE LinkNode.NodeCode = RL.Target NO-LOCK NO-ERROR.
1610     IF NOT AVAILABLE LinkNode THEN RETURN.
1611     IF TRIM(LinkNode.RunFile) = "" AND TRIM(LinkNode.File) = "" THEN RETURN "FAIL".
1612     RUN verify-prog( IF LinkNode.RunFile <> "" THEN LinkNode.RunFile ELSE LinkNode.File, OUTPUT prog-name ).
1613     IF RETURN-VALUE <> "FAIL" THEN
1614       RUN VALUE( prog-name ) PERSISTENT SET RL.dst-hdl.
1615     ELSE
1616       RETURN "FAIL".
1617
1618     IF RL.LinkType = "SEL" THEN DO:
1619       DEF VAR ctr-hdl AS CHAR NO-UNDO.
1620       RUN get-link-handle IN adm-broker-hdl ( RL.src-hdl, 'CONTAINER-SOURCE', OUTPUT ctr-hdl ).
1621       RUN add-link IN adm-broker-hdl( WIDGET-HANDLE( ctr-hdl ), 'WINMGR', RL.dst-hdl ).
1622     END.
1623     ELSE
1624       RUN add-link IN adm-broker-hdl ( RL.src-hdl, 'WINMGR':U, RL.dst-hdl ).
1625
1626     RUN set-attribute-list IN RL.dst-hdl(
1627       "FileName = " + LinkNode.File + "," +
1628       "LinkId = "   + STRING( ROWID( RL ) ) ).
1629
1630     RUN set-window-title( window-title ).
1631     RUN dispatch IN RL.dst-hdl ( 'Initialize':U ).
1632     RUN update-node( RL.dst-hdl ).
1633
1634     FIND Dst WHERE Dst.proc-hdl = RL.dst-hdl.
1635     ASSIGN Dst.Context = window-title.
1636     IF RL.LinkType <> "SEL" THEN RUN dispatch IN Dst.vwr-hdl ( 'row-available':U ).
1637     RUN iterate-widgets( Dst.frm-hdl, THIS-PROCEDURE, "set-db-tool-tip" ).
1638
1639     /* Running the link may have caused the parent to close so check first */
1640     IF AVAILABLE RL AND VALID-HANDLE( RL.src-hdl ) THEN RUN set-idle IN RL.src-hdl.
1641
1642     RUN dispatch IN (IF VALID-HANDLE( Dst.vwr-hdl ) THEN Dst.vwr-hdl ELSE RL.dst-hdl) ( 'apply-entry' ) NO-ERROR.
1643   END.
1644
1645 END PROCEDURE.
1646
1647 /* _UIB-CODE-BLOCK-END */
1648 &ANALYZE-RESUME
1649
1650 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE select-ok W-Win
1651 PROCEDURE select-ok :
1652 /*------------------------------------------------------------------------------
1653   Purpose:
1654 ------------------------------------------------------------------------------*/
1655 DEF INPUT PARAMETER proc-hdl AS HANDLE NO-UNDO.
1656
1657 DEF VAR new-id  AS ROWID NO-UNDO.
1658 DEF VAR enabled AS LOGI  NO-UNDO.
1659 DEF VAR fill-in-hdl AS HANDLE NO-UNDO.
1660
1661   FIND Node WHERE Node.proc-hdl = proc-hdl.
1662   RUN get-curr-id IN Node.vwr-hdl ( OUTPUT new-id ).
1663
1664   RUN get-attribute IN proc-hdl ( 'LinkId':U ).
1665   FIND Link WHERE ROWID( Link ) = TO-ROWID( RETURN-VALUE ).
1666
1667   fill-in-hdl = Link.fil-hdl .
1668   fill-in-hdl:PRIVATE-DATA = STRING( new-id ).
1669
1670   enabled = fill-in-hdl:SENSITIVE.
1671   fill-in-hdl:SENSITIVE = Yes.
1672   APPLY 'U2':U TO fill-in-hdl.
1673   fill-in-hdl:SENSITIVE = enabled.
1674
1675 END PROCEDURE.
1676
1677 /* _UIB-CODE-BLOCK-END */
1678 &ANALYZE-RESUME
1679
1680 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records W-Win  _ADM-SEND-RECORDS
1681 PROCEDURE send-records :
1682 /*------------------------------------------------------------------------------
1683   Purpose:     Send record ROWID's for all tables used by
1684                this file.
1685   Parameters:  see template/snd-head.i
1686 ------------------------------------------------------------------------------*/
1687
1688   /* SEND-RECORDS does nothing because there are no External
1689      Tables specified for this SmartWindow, and there are no
1690      tables specified in any contained Browse, Query, or Frame. */
1691
1692 END PROCEDURE.
1693
1694 /* _UIB-CODE-BLOCK-END */
1695 &ANALYZE-RESUME
1696
1697 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-busy W-Win
1698 PROCEDURE set-busy :
1699 /*------------------------------------------------------------------------------
1700   Purpose:
1701 ------------------------------------------------------------------------------*/
1702   SESSION:SET-WAIT-STATE("WAIT").
1703 END PROCEDURE.
1704
1705 /* _UIB-CODE-BLOCK-END */
1706 &ANALYZE-RESUME
1707
1708 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-db-identifiers W-Win
1709 PROCEDURE set-db-identifiers :
1710 /*------------------------------------------------------------------------------
1711   Purpose:
1712 ------------------------------------------------------------------------------*/
1713 {inc/ofc-this.i}
1714 IF AVAILABLE(Office) THEN DO:
1715   FIND OfficeSettings OF Office WHERE OfficeSettings.SetName = unique-db-identifier() NO-LOCK NO-ERROR.
1716   IF AVAILABLE(OfficeSettings) THEN ASSIGN
1717         window-title-prefix = TRIM(ENTRY(1,OfficeSettings.SetValue,"|")) + " "
1718         system-description  = TRIM(ENTRY(2,OfficeSettings.SetValue,"|")) + " "
1719         window-icon-file    = TRIM(ENTRY(3,OfficeSettings.SetValue,"|")) + " "
1720         menu-bitmap-file    = TRIM(ENTRY(4,OfficeSettings.SetValue,"|")) + " " NO-ERROR .
1721   {inc/ofc-set.i "Last-Replicate-Data" "last-data"}
1722   IF NOT AVAILABLE(OfficeSetting) THEN last-data = "".
1723   {inc/ofc-set.i "Last-Replicate-Run" "last-run"}
1724   IF NOT AVAILABLE(OfficeSetting) THEN last-run = "".
1725
1726   IF last-data <> "" THEN DO:
1727     system-description = "Change: " + last-data.
1728     IF last-run <> "" THEN
1729       system-description = system-description + ",   Load: " + last-run.
1730   END.
1731 END.
1732
1733 IF window-title-prefix = ? THEN window-title-prefix = "".
1734 IF system-description = ? THEN  system-description  = "Capital APMS" + " - " + unique-db-identifier() + " not set".
1735 IF window-icon-file = ? THEN    window-icon-file    = "bitmaps/capital.ico".
1736 IF menu-bitmap-file = ? THEN    menu-bitmap-file    = "bitmaps/mainmenu.bmp".
1737
1738 END PROCEDURE.
1739
1740 /* _UIB-CODE-BLOCK-END */
1741 &ANALYZE-RESUME
1742
1743 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-db-tool-tip W-Win
1744 PROCEDURE set-db-tool-tip :
1745 /*------------------------------------------------------------------------------
1746   Purpose:
1747   Parameters:  <none>
1748   Notes:
1749 ------------------------------------------------------------------------------*/
1750
1751   DEF INPUT PARAMETER wh AS HANDLE.
1752
1753   DEF VAR tool-tip AS CHAR NO-UNDO.
1754
1755   IF CAN-QUERY( wh, "TABLE" ) AND wh:TABLE <> ? THEN DO:
1756     FIND _File WHERE _File._File-Name = wh:TABLE NO-LOCK.
1757     FIND _Field
1758     WHERE _Field._File-RecID = RECID( _File )
1759       AND _Field._Field-Name = wh:NAME
1760       NO-LOCK NO-ERROR.
1761     IF AVAILABLE _Field THEN tool-tip =
1762       IF _Field._Help <> "" THEN _Field._Help ELSE
1763       IF _Field._Desc <> "" THEN _Field._Desc ELSE "".
1764
1765     IF tool-tip <> ? AND tool-tip <> "" THEN wh:TOOLTIP = tool-tip.
1766   END.
1767
1768 END PROCEDURE.
1769
1770 /* _UIB-CODE-BLOCK-END */
1771 &ANALYZE-RESUME
1772
1773 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-idle W-Win
1774 PROCEDURE set-idle :
1775 /*------------------------------------------------------------------------------
1776   Purpose:
1777 ------------------------------------------------------------------------------*/
1778   SESSION:SET-WAIT-STATE("").
1779 END PROCEDURE.
1780
1781 /* _UIB-CODE-BLOCK-END */
1782 &ANALYZE-RESUME
1783
1784 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-link-attributes W-Win
1785 PROCEDURE set-link-attributes :
1786 /*------------------------------------------------------------------------------
1787   Purpose:
1788 ------------------------------------------------------------------------------*/
1789 DEF INPUT PARAMETER proc-hdl AS HANDLE NO-UNDO.
1790 DEF INPUT PARAMETER id-list AS CHAR    NO-UNDO.
1791 DEF INPUT PARAMETER attribs AS CHAR    NO-UNDO.
1792
1793 DEF VAR i AS INT NO-UNDO.
1794 DEF VAR id-entry AS CHAR NO-UNDO.
1795
1796   FIND FIRST Node WHERE Node.proc-hdl = proc-hdl OR Node.vwr-hdl = proc-hdl NO-ERROR.
1797   IF NOT AVAILABLE Node THEN DO:
1798     MESSAGE "Node not valid - unable to set link attributes: " SKIP
1799            id-list SKIP
1800            attribs .
1801     RETURN.
1802   END.
1803
1804   /* Modify the appropriate link from the given id ( Node Type dependent ) */
1805   DO i = 1 TO NUM-ENTRIES( id-list ):
1806     id-entry = ENTRY( i, id-list ).
1807     IF id-entry = "ALL" THEN id-entry = "*".
1808     CASE id-entry:
1809       WHEN "Viewer" THEN DO:
1810           FOR EACH Link WHERE Link.src-hdl = Node.vwr-hdl:
1811             RUN each-link( attribs ).
1812           END.
1813         END.
1814       WHEN "Window" THEN DO:
1815           FOR EACH Link WHERE Link.src-hdl = Node.proc-hdl:
1816             RUN each-link( attribs ).
1817           END.
1818         END.
1819       OTHERWISE DO:
1820           FOR EACH Link WHERE Link.link-id MATCHES ENTRY( i, id-list )
1821               AND (Link.src-hdl = Node.proc-hdl OR Link.src-hdl = Node.vwr-hdl):
1822             RUN each-link( attribs ).
1823           END.
1824         END.
1825     END CASE.
1826   END.
1827
1828 END PROCEDURE.
1829
1830 /* _UIB-CODE-BLOCK-END */
1831 &ANALYZE-RESUME
1832
1833 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-uib-modus-operandi W-Win
1834 PROCEDURE set-uib-modus-operandi :
1835 /*------------------------------------------------------------------------------
1836   Purpose:  So that we act slightly differently if the uib is running
1837 ------------------------------------------------------------------------------*/
1838   uib-operational-mode = Yes.
1839 END PROCEDURE.
1840
1841 /* _UIB-CODE-BLOCK-END */
1842 &ANALYZE-RESUME
1843
1844 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-window-icon W-Win
1845 PROCEDURE set-window-icon :
1846 /*------------------------------------------------------------------------------
1847   Purpose: Set the window icon to the specified icon file.
1848 ------------------------------------------------------------------------------*/
1849 DEF INPUT PARAMETER win-hdl AS HANDLE NO-UNDO.
1850
1851   IF win-hdl:LOAD-ICON( window-icon-file ) THEN .
1852
1853   win-hdl:KEEP-FRAME-Z-ORDER = focus-parent-on-close.
1854
1855 END PROCEDURE.
1856
1857 /* _UIB-CODE-BLOCK-END */
1858 &ANALYZE-RESUME
1859
1860 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-window-title W-Win
1861 PROCEDURE set-window-title :
1862 /*------------------------------------------------------------------------------
1863   Purpose:     Called from run link to set the window title
1864   Notes:       RL must be available
1865 ------------------------------------------------------------------------------*/
1866 DEF INPUT PARAMETER proc-title AS CHAR NO-UNDO.
1867
1868 DEF VAR proc-win   AS HANDLE NO-UNDO.
1869
1870   RUN get-window-handle IN RL.dst-hdl.
1871   proc-win = WIDGET-HANDLE( RETURN-VALUE ).
1872   IF VALID-HANDLE(proc-win) THEN
1873     proc-win:TITLE = window-title-prefix + proc-title.
1874
1875 END PROCEDURE.
1876
1877 /* _UIB-CODE-BLOCK-END */
1878 &ANALYZE-RESUME
1879
1880 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed W-Win
1881 PROCEDURE state-changed :
1882 /* -----------------------------------------------------------
1883   Purpose:
1884   Parameters:  <none>
1885   Notes:
1886 -------------------------------------------------------------*/
1887   DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE NO-UNDO.
1888   DEFINE INPUT PARAMETER p-state AS CHARACTER NO-UNDO.
1889 END PROCEDURE.
1890
1891 /* _UIB-CODE-BLOCK-END */
1892 &ANALYZE-RESUME
1893
1894 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE temp-filename W-Win
1895 PROCEDURE temp-filename :
1896 /*------------------------------------------------------------------------------
1897   Purpose:  Return a temp file name
1898 ------------------------------------------------------------------------------*/
1899
1900   DEF OUTPUT PARAMETER file-name AS CHAR NO-UNDO.
1901
1902   file-name = OS-GETENV("TEMP") + "/proptemp.txt".
1903
1904 END PROCEDURE.
1905
1906 /* _UIB-CODE-BLOCK-END */
1907 &ANALYZE-RESUME
1908
1909 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-maxes W-Win
1910 PROCEDURE update-maxes :
1911 /*------------------------------------------------------------------------------
1912   Purpose:
1913   Parameters:  <none>
1914   Notes:
1915 ------------------------------------------------------------------------------*/
1916
1917   DEF INPUT PARAMETER node-btn AS HANDLE NO-UNDO.
1918
1919   IF node-btn:x + node-btn:width-pixels + {&GAP} > max-x THEN
1920     max-x = node-btn:x + node-btn:width-pixels + {&GAP}.
1921
1922   IF node-btn:y + node-btn:height-pixels + {&GAP} > max-y THEN
1923     max-y = node-btn:y + node-btn:height-pixels + {&GAP}.
1924
1925 END PROCEDURE.
1926
1927 /* _UIB-CODE-BLOCK-END */
1928 &ANALYZE-RESUME
1929
1930 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-node W-Win
1931 PROCEDURE update-node :
1932 /*------------------------------------------------------------------------------
1933   Purpose:     Updates the button description of the node
1934 ------------------------------------------------------------------------------*/
1935 DEF INPUT PARAMETER proc-hdl AS HANDLE NO-UNDO.
1936
1937 DEF VAR proc-btn AS HANDLE NO-UNDO.
1938 DEF VAR proc-win AS HANDLE NO-UNDO.
1939 DEF VAR new-label AS CHAR NO-UNDO.
1940
1941   proc-btn = WIDGET-HANDLE( proc-hdl:PRIVATE-DATA ).
1942   IF NOT VALID-HANDLE(proc-btn) THEN DO:
1943   DEF BUFFER MyNode FOR Node.
1944     FIND FIRST MyNode WHERE MyNode.vwr-hdl = proc-hdl NO-ERROR.
1945     IF AVAILABLE(MyNode) THEN proc-hdl = MyNode.proc-hdl .
1946     proc-btn = WIDGET-HANDLE( proc-hdl:PRIVATE-DATA ).
1947   END.
1948
1949   proc-win = proc-hdl:CURRENT-WINDOW.
1950   IF VALID-HANDLE(proc-win) THEN DO:
1951     new-label = proc-win:TITLE.
1952     IF VALID-HANDLE( proc-btn ) THEN DO:
1953       IF SUBSTRING( new-label, 1, LENGTH(window-title-prefix)) = window-title-prefix THEN
1954         new-label = SUBSTRING( new-label, LENGTH(window-title-prefix) + 1).
1955       proc-btn:HIDDEN = Yes.
1956       proc-btn:AUTO-RESIZE = Yes.
1957       proc-btn:LABEL = new-label.
1958       RUN crop-button( proc-btn ).
1959       RUN redraw IN THIS-PROCEDURE.
1960     END.
1961   END.
1962
1963 END PROCEDURE.
1964
1965 /* _UIB-CODE-BLOCK-END */
1966 &ANALYZE-RESUME
1967
1968 /* ************************  Function Implementations ***************** */
1969
1970 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION extract-attribute W-Win
1971 FUNCTION extract-attribute RETURNS CHARACTER
1972   ( INPUT attribute-list AS CHAR, INPUT attribute-name AS CHAR ) :
1973 /*------------------------------------------------------------------------------
1974   Purpose:
1975     Notes:
1976 ------------------------------------------------------------------------------*/
1977 DEF VAR i       AS INT  NO-UNDO.
1978 DEF VAR n       AS INT  NO-UNDO.
1979 DEF VAR setting AS CHAR NO-UNDO.
1980
1981   n = NUM-ENTRIES( attribute-list ).
1982   DO i = 1 TO n:
1983     setting = ENTRY( i, attribute-list ).
1984     IF TRIM( ENTRY( 1, setting, "=" ) ) = attribute-name
1985                        AND NUM-ENTRIES( setting, "=" ) > 1
1986     THEN
1987        RETURN TRIM( ENTRY( 2, setting, "=" ) ).
1988   END.
1989
1990   RETURN "".
1991
1992 END FUNCTION.
1993
1994 /* _UIB-CODE-BLOCK-END */
1995 &ANALYZE-RESUME
1996
1997 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-window-program W-Win
1998 FUNCTION get-window-program RETURNS HANDLE
1999   ( INPUT window-hdl AS WIDGET-HANDLE ) :
2000 /*------------------------------------------------------------------------------
2001   Purpose:  Find the program for this window
2002     Notes:
2003 ------------------------------------------------------------------------------*/
2004 DEF VAR proc-hdl AS WIDGET-HANDLE NO-UNDO.
2005
2006   proc-hdl = SESSION:FIRST-PROCEDURE.
2007   REPEAT:
2008     IF VALID-HANDLE(proc-hdl) AND proc-hdl:CURRENT-WINDOW = window-hdl THEN
2009       RETURN proc-hdl.
2010     proc-hdl = proc-hdl:NEXT-SIBLING.
2011   END.
2012
2013   RETURN ?.
2014
2015 END FUNCTION.
2016
2017 /* _UIB-CODE-BLOCK-END */
2018 &ANALYZE-RESUME
2019
2020 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-window-title W-Win
2021 FUNCTION get-window-title RETURNS CHARACTER
2022   ( /* parameter-definitions */ ) :
2023 /*------------------------------------------------------------------------------
2024   Purpose:
2025     Notes:  RL Must be available
2026 ------------------------------------------------------------------------------*/
2027
2028   DEF VAR proc-title AS CHAR   NO-UNDO.
2029   DEF VAR proc-win   AS HANDLE NO-UNDO.
2030   DEF VAR topic-vwr  AS HANDLE NO-UNDO.
2031   DEF VAR topic-desc AS CHAR   NO-UNDO.
2032
2033   IF RL.LinkType = "SEL" THEN
2034   DO:
2035     DEF VAR select-item AS CHAR NO-UNDO.
2036
2037     select-item =
2038       IF VALID-HANDLE( RL.fil-hdl ) AND RL.fil-hdl:label <> ? THEN RL.fil-hdl:label ELSE
2039       IF VALID-HANDLE( RL.cde-hdl ) AND RL.cde-hdl:label <> ? THEN RL.cde-hdl:label ELSE "".
2040
2041     IF select-item = "" AND VALID-HANDLE( RL.cde-hdl ) THEN
2042     DO:
2043       DEF VAR prev-tab AS HANDLE NO-UNDO.
2044       prev-tab = RL.cde-hdl:PREV-TAB-ITEM.
2045       IF VALID-HANDLE( prev-tab ) THEN select-item = prev-tab:LABEL.
2046     END.
2047
2048     topic-vwr = RL.src-hdl.
2049     proc-title = TRIM( "Select " + select-item ).
2050
2051   END.
2052   ELSE
2053   DO:
2054     DEF BUFFER Src FOR Node.
2055     FIND Src WHERE Src.proc-hdl = RL.src-hdl.
2056     topic-vwr  = Src.vwr-hdl.
2057     proc-title = REPLACE( RL.btn-hdl:LABEL, "&", "" ).
2058   END.
2059
2060
2061   IF VALID-HANDLE( topic-vwr ) THEN DO:
2062     RUN get-topic-desc IN topic-vwr ( OUTPUT topic-desc ) NO-ERROR.
2063     IF NOT ERROR-STATUS:ERROR AND topic-desc <> "" THEN
2064       proc-title = proc-title + " - " + topic-desc.
2065   END.
2066
2067   IF SUBSTRING( proc-title, 1, LENGTH(window-title-prefix) ) = window-title-prefix THEN
2068     proc-title = SUBSTRING( proc-title, LENGTH(window-title-prefix) + 1).
2069
2070   RETURN proc-title.   /* Function return value. */
2071
2072 END FUNCTION.
2073
2074 /* _UIB-CODE-BLOCK-END */
2075 &ANALYZE-RESUME
2076
2077 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION link-running W-Win
2078 FUNCTION link-running RETURNS LOGICAL
2079   ( OUTPUT window-title AS CHAR ) :
2080 /*------------------------------------------------------------------------------
2081   Purpose:
2082     Notes:  RL must be available ( The run link record )
2083 ------------------------------------------------------------------------------*/
2084 DEF VAR dest-win AS HANDLE NO-UNDO.
2085 DEF BUFFER TestNode FOR Node.
2086
2087   window-title = get-window-title().
2088
2089   IF RL.LinkType = "MSG" /* Message links are never running */
2090      THEN RETURN No.
2091
2092   /* Check to see if the link is already running in the given context */
2093   FIND FIRST TestNode WHERE TestNode.Node-Code = RL.Target
2094                         AND TestNode.Context = window-title
2095                         AND VALID-HANDLE( TestNode.proc-hdl ) NO-LOCK NO-ERROR.
2096   IF AVAILABLE TestNode THEN DO:
2097     IF LOOKUP( RL.LinkType, "SEL,DRL,MNT" ) <> 0
2098       /* AND There is no topic description in the current viewer */
2099       AND NUM-ENTRIES( window-title, '-' ) <= 1
2100       /* AND The origin of the link is not a menu */
2101       AND NOT CAN-FIND( FIRST LinkNode WHERE
2102         LinkNode.NodeCode = RL.Source AND
2103         LinkNode.NodeType = "MN" )
2104       THEN RETURN No.
2105
2106     RUN set-idle IN RL.src-hdl.
2107     RUN focus-window IN THIS-PROCEDURE ( TestNode.proc-hdl ).
2108     RETURN Yes.
2109
2110   END.
2111
2112   RETURN No.
2113
2114 END FUNCTION.
2115
2116 /* _UIB-CODE-BLOCK-END */
2117 &ANALYZE-RESUME
2118
2119 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION unique-db-identifier W-Win
2120 FUNCTION unique-db-identifier RETURNS CHARACTER
2121   ( /* parameter-definitions */ ) :
2122 /*------------------------------------------------------------------------------
2123   Purpose:  Returns a DB identifier which is built in a structured way from the
2124             various components of the DBPARM() list.
2125     Notes:  Only looks at the first database connected - this should be the most
2126             unique one, certainly currently.  It is possible to envisage a
2127             situation where this assumption is false.
2128 ------------------------------------------------------------------------------*/
2129 DEF VAR db-parm AS CHAR NO-UNDO.
2130 DEF VAR net-details AS CHAR NO-UNDO INITIAL "Local".
2131 DEF VAR svr-name AS CHAR NO-UNDO INITIAL "".
2132 DEF VAR svc-code AS CHAR NO-UNDO INITIAL "".
2133 DEF VAR db-name AS CHAR NO-UNDO INITIAL "".
2134 DEF VAR single-user AS LOGICAL NO-UNDO INITIAL No.
2135 DEF VAR i AS INT NO-UNDO.
2136 DEF VAR n AS INT NO-UNDO.
2137 DEF VAR parm AS CHAR NO-UNDO.
2138
2139   db-parm = DBPARAM(1).
2140   IF db-parm = ? THEN RETURN ?.
2141   n = NUM-ENTRIES(db-parm).
2142   DO i = 1 TO n:
2143     parm = ENTRY(i,db-parm).
2144     CASE ENTRY(1,parm," "):
2145       WHEN "-1" THEN    single-user = Yes.
2146       WHEN "-db" THEN   db-name = ENTRY(2, parm, " ").
2147       WHEN "-N" THEN    net-details = ENTRY(2, parm, " ").
2148       WHEN "-H" THEN    svr-name = ENTRY(2, parm, " ").
2149       WHEN "-S" THEN    svc-code = ENTRY(2, parm, " ").
2150     END CASE.
2151   END.
2152
2153   IF SUBSTRING( db-name, LENGTH(db-name) - 2) = ".DB" THEN
2154     db-name = SUBSTRING( db-name, 1, LENGTH(db-name) - 3).
2155
2156   IF net-details <> "Local" THEN
2157     net-details = net-details + ":" + svr-name + ":" + svc-code.
2158
2159   RETURN net-details + "-" + db-name + (IF single-user THEN "-1" ELSE "").
2160
2161 END FUNCTION.
2162
2163 /* _UIB-CODE-BLOCK-END */
2164 &ANALYZE-RESUME
2165