inc/method/m-mstvwr.i

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Method-Library
   4 /*--------------------------------------------------------------------------
   5   ------------------------------------------------------------------------*/
   6
   7 /* ***************************  Definitions  ************************** */
   8
   9 DEF VAR have-records AS LOGI INIT NO NO-UNDO.
  10 DEF VAR this-file    AS CHAR NO-UNDO.
  11
  12 /* _UIB-CODE-BLOCK-END */
  13 &ANALYZE-RESUME
  14
  15
  16 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  17
  18 /* ********************  Preprocessor Definitions  ******************** */
  19
  20
  21
  22 /* _UIB-PREPROCESSOR-BLOCK-END */
  23 &ANALYZE-RESUME
  24
  25
  26 /* ************************  Function Prototypes ********************** */
  27
  28 &IF DEFINED(EXCLUDE-find-parent-key) = 0 &THEN
  29
  30 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD find-parent-key Method-Library
  31 FUNCTION find-parent-key RETURNS CHARACTER
  32   ( INPUT key-name AS CHAR )  FORWARD.
  33
  34 /* _UIB-CODE-BLOCK-END */
  35 &ANALYZE-RESUME
  36
  37 &ENDIF
  38
  39
  40 /* *********************** Procedure Settings ************************ */
  41
  42 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  43 /* Settings for THIS-PROCEDURE
  44    Type: Method-Library
  45    Allow:
  46    Frames: 0
  47    Add Fields to: Neither
  48    Other Settings: INCLUDE-ONLY
  49  */
  50 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  51
  52 /* *************************  Create Window  ************************** */
  53
  54 &ANALYZE-SUSPEND _CREATE-WINDOW
  55 /* DESIGN Window definition (used by the UIB)
  56   CREATE WINDOW Method-Library ASSIGN
  57          HEIGHT             = .05
  58          WIDTH              = 44.57.
  59 /* END WINDOW DEFINITION */
  60                                                                         */
  61 &ANALYZE-RESUME
  62
  63
  64
  65 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Method-Library
  66 /* ************************* Included-Libraries *********************** */
  67
  68 {inc/method/m-sysmgr.i}
  69 {inc/method/m-utils.i}
  70
  71 /* _UIB-CODE-BLOCK-END */
  72 &ANALYZE-RESUME
  73
  74
  75
  76 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Method-Library
  77
  78
  79 /* ***************************  Main Block  *************************** */
  80 this-file = REPLACE( SEARCH( THIS-PROCEDURE:FILE-NAME ), "\", "/" ).
  81 this-file = REPLACE( this-file, "./", "" ).
  82
  83 RUN set-attribute-list (
  84   "frame-handle = " + STRING( FRAME {&FRAME-NAME}:HANDLE ) + "," +
  85   "filename = "     + this-file ).
  86
  87 /* _UIB-CODE-BLOCK-END */
  88 &ANALYZE-RESUME
  89
  90
  91 /* **********************  Internal Procedures  *********************** */
  92
  93 &IF DEFINED(EXCLUDE-get-topic-desc) = 0 &THEN
  94
  95 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-topic-desc Method-Library
  96 PROCEDURE get-topic-desc :
  97 /*------------------------------------------------------------------------------
  98   Purpose:     Get the description of the topic for this
  99                viewer.
 100 ------------------------------------------------------------------------------*/
 101
 102   DEF OUTPUT PARAMETER topic-desc AS CHAR NO-UNDO.
 103
 104   &IF DEFINED( TOPIC-TABLE ) NE 0 AND
 105       DEFINED( TOPIC-FIELD ) NE 0 &THEN
 106
 107     topic-desc = IF AVAILABLE {&TOPIC-TABLE}
 108       THEN {&TOPIC-PREFIX} + " " + STRING({&TOPIC-FIELD})
 109       ELSE "{&TOPIC-TABLE}".
 110     topic-desc = TRIM( topic-desc ).
 111
 112   &ENDIF
 113
 114 END PROCEDURE.
 115
 116 /* _UIB-CODE-BLOCK-END */
 117 &ANALYZE-RESUME
 118
 119 &ENDIF
 120
 121 &IF DEFINED(EXCLUDE-local-display-fields) = 0 &THEN
 122
 123 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-display-fields Method-Library
 124 PROCEDURE local-display-fields :
 125 /*------------------------------------------------------------------------------
 126   Purpose:     Override standard ADM method
 127   Notes:
 128 ------------------------------------------------------------------------------*/
 129
 130   RUN pre-display-fields  IN THIS-PROCEDURE NO-ERROR.
 131
 132   /* Dispatch standard ADM method.                             */
 133   RUN dispatch IN THIS-PROCEDURE ( INPUT 'display-fields':U ) .
 134
 135   /* Code placed here will execute AFTER standard behavior.    */
 136   RUN sub1-display-fields IN THIS-PROCEDURE NO-ERROR.
 137   RUN inst-display-fields IN THIS-PROCEDURE NO-ERROR.
 138   RUN post-display-fields IN THIS-PROCEDURE NO-ERROR.
 139
 140 END PROCEDURE.
 141
 142 /* _UIB-CODE-BLOCK-END */
 143 &ANALYZE-RESUME
 144
 145 &ENDIF
 146
 147 &IF DEFINED(EXCLUDE-local-enable-fields) = 0 &THEN
 148
 149 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-enable-fields Method-Library
 150 PROCEDURE local-enable-fields :
 151 /*------------------------------------------------------------------------------
 152   Purpose:     Override standard ADM method
 153   Notes:
 154 ------------------------------------------------------------------------------*/
 155
 156   /* Code placed here will execute PRIOR to standard behavior. */
 157   IF INDEX( THIS-PROCEDURE:INTERNAL-ENTRIES, 'override-enable-fields') > 0 THEN DO:
 158     RUN override-enable-fields IN THIS-PROCEDURE NO-ERROR.
 159     RETURN.
 160   END.
 161   RUN pre-enable-fields IN THIS-PROCEDURE NO-ERROR.
 162
 163   /* Dispatch standard ADM method.                             */
 164   IF RETURN-VALUE = "LEAVE" THEN RETURN.
 165   RUN dispatch IN THIS-PROCEDURE ( INPUT 'enable-fields':U ) .
 166   RUN set-link-attributes IN sys-mgr ( THIS-PROCEDURE, "ALL", "SENSITIVE = Yes" ).
 167   RUN inst-enable-fields IN THIS-PROCEDURE NO-ERROR.
 168
 169   /* Code placed here will execute AFTER standard behavior.    */
 170
 171 END PROCEDURE.
 172
 173 /* _UIB-CODE-BLOCK-END */
 174 &ANALYZE-RESUME
 175
 176 &ENDIF
 177
 178 &IF DEFINED(EXCLUDE-local-initialize) = 0 &THEN
 179
 180 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-initialize Method-Library
 181 PROCEDURE local-initialize :
 182 /*------------------------------------------------------------------------------
 183   Purpose:     Override standard ADM method
 184   Notes:
 185 ------------------------------------------------------------------------------*/
 186
 187   /* Code placed here will execute PRIOR to standard behavior. */
 188
 189   RUN pre-initialize      IN THIS-PROCEDURE NO-ERROR.
 190   RUN pre-create-objects  IN THIS-PROCEDURE NO-ERROR.
 191   RUN sub1-create-objects IN THIS-PROCEDURE NO-ERROR.
 192   RUN inst-create-objects IN THIS-PROCEDURE NO-ERROR.
 193   RUN post-create-objects IN THIS-PROCEDURE NO-ERROR.
 194
 195   /* Dispatch standard ADM method.                             */
 196   RUN dispatch IN THIS-PROCEDURE ( INPUT 'initialize':U ) .
 197
 198   /* Code placed here will execute AFTER standard behavior.    */
 199
 200   RUN sub1-initialize IN THIS-PROCEDURE NO-ERROR.
 201   RUN inst-initialize IN THIS-PROCEDURE NO-ERROR.
 202   RUN post-initialize IN THIS-PROCEDURE NO-ERROR.
 203
 204 END PROCEDURE.
 205
 206 /* _UIB-CODE-BLOCK-END */
 207 &ANALYZE-RESUME
 208
 209 &ENDIF
 210
 211 &IF DEFINED(EXCLUDE-local-row-available) = 0 &THEN
 212
 213 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-row-available Method-Library
 214 PROCEDURE local-row-available :
 215 /*------------------------------------------------------------------------------
 216   Purpose:     Override standard ADM method
 217   Notes:
 218 ------------------------------------------------------------------------------*/
 219   IF INDEX( THIS-PROCEDURE:INTERNAL-ENTRIES, 'override-row-available') > 0 THEN DO:
 220     RUN override-row-available IN THIS-PROCEDURE NO-ERROR.
 221     RETURN.
 222   END.
 223   /* If this viewer has been destroyed or is hidden then just return */
 224
 225   RUN get-attribute IN THIS-PROCEDURE( 'adm-object-handle':U ).
 226   IF NOT VALID-HANDLE( WIDGET-HANDLE( RETURN-VALUE ) ) THEN RETURN.
 227   RUN get-attribute IN THIS-PROCEDURE( 'container-hidden' ).
 228   IF RETURN-VALUE = "Yes" THEN RETURN.
 229
 230   RUN sub1-pre-row-available IN THIS-PROCEDURE NO-ERROR.
 231   RUN pre-row-available      IN THIS-PROCEDURE NO-ERROR.
 232
 233   /* Static link between linked viewers */
 234
 235   RUN get-attribute IN THIS-PROCEDURE ( 'Initialized':U ).
 236
 237   IF RETURN-VALUE = "Yes" AND NOT have-records THEN
 238   DO:
 239     RUN dispatch IN THIS-PROCEDURE ( INPUT 'row-available':U ) .
 240     RUN inst-row-available IN THIS-PROCEDURE NO-ERROR.
 241     RUN sub1-row-available IN THIS-PROCEDURE NO-ERROR.
 242     RUN post-row-available IN THIS-PROCEDURE NO-ERROR.
 243     have-records = Yes.
 244   END.
 245
 246 END PROCEDURE.
 247
 248 /* _UIB-CODE-BLOCK-END */
 249 &ANALYZE-RESUME
 250
 251 &ENDIF
 252
 253 &IF DEFINED(EXCLUDE-refresh-topic) = 0 &THEN
 254
 255 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE refresh-topic Method-Library
 256 PROCEDURE refresh-topic :
 257 /*------------------------------------------------------------------------------
 258   Purpose:  Refresh the topic for record-targets
 259 ------------------------------------------------------------------------------*/
 260 DEF VAR new-topic AS CHAR NO-UNDO.
 261
 262   RUN get-topic-desc( OUTPUT new-topic ).
 263   RETURN new-topic.
 264
 265 END PROCEDURE.
 266
 267 /* _UIB-CODE-BLOCK-END */
 268 &ANALYZE-RESUME
 269
 270 &ENDIF
 271
 272 &IF DEFINED(EXCLUDE-set-busy) = 0 &THEN
 273
 274 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-busy Method-Library
 275 PROCEDURE set-busy :
 276 /*------------------------------------------------------------------------------
 277   Purpose:
 278   Parameters:  <none>
 279   Notes:
 280 ------------------------------------------------------------------------------*/
 281
 282   RUN notify( 'set-busy, CONTAINER-SOURCE':U ).
 283
 284 END PROCEDURE.
 285
 286 /* _UIB-CODE-BLOCK-END */
 287 &ANALYZE-RESUME
 288
 289 &ENDIF
 290
 291 &IF DEFINED(EXCLUDE-set-idle) = 0 &THEN
 292
 293 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-idle Method-Library
 294 PROCEDURE set-idle :
 295 /*------------------------------------------------------------------------------
 296   Purpose:
 297   Parameters:  <none>
 298   Notes:
 299 ------------------------------------------------------------------------------*/
 300
 301   RUN notify( 'set-idle, CONTAINER-SOURCE':U ).
 302
 303 END PROCEDURE.
 304
 305 /* _UIB-CODE-BLOCK-END */
 306 &ANALYZE-RESUME
 307
 308 &ENDIF
 309
 310 &IF DEFINED(EXCLUDE-test-modified) = 0 &THEN
 311
 312 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE test-modified Method-Library
 313 PROCEDURE test-modified :
 314 /*------------------------------------------------------------------------------
 315   Purpose:  Test to see if the current crop of fields is modified
 316 ------------------------------------------------------------------------------*/
 317 DEF OUTPUT PARAMETER record-changed AS LOGICAL NO-UNDO INITIAL No.
 318
 319   /* This block of code was developed from src/adm/method/tableio.i - check-modified */
 320   IF VALID-HANDLE(FRAME {&FRAME-NAME}:HANDLE)
 321 &IF DEFINED(adm-first-enabled-table) = 0 &THEN
 322             AND AVAILABLE({&adm-first-enabled-table})
 323 &ENDIF
 324   THEN DO:
 325   DEF VAR curr-widget AS HANDLE NO-UNDO.
 326
 327     ASSIGN curr-widget = FRAME {&FRAME-NAME}:FIRST-CHILD. /* Field group */
 328     ASSIGN curr-widget = curr-widget:FIRST-CHILD. /* First field */
 329     DO WHILE NOT record-changed AND VALID-HANDLE (curr-widget):
 330       record-changed = LOOKUP (curr-widget:TYPE, "FILL-IN,COMBO-BOX,EDITOR,RADIO-SET,SELECTION-LIST,SLIDER,TOGGLE-BOX":U) NE 0
 331                      AND curr-widget:MODIFIED.
 332       ASSIGN curr-widget = curr-widget:NEXT-SIBLING. /* next field */
 333     END.
 334   END.
 335
 336 END PROCEDURE.
 337
 338 /* _UIB-CODE-BLOCK-END */
 339 &ANALYZE-RESUME
 340
 341 &ENDIF
 342
 343 /* ************************  Function Implementations ***************** */
 344
 345 &IF DEFINED(EXCLUDE-find-parent-key) = 0 &THEN
 346
 347 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION find-parent-key Method-Library
 348 FUNCTION find-parent-key RETURNS CHARACTER
 349   ( INPUT key-name AS CHAR ) :
 350 /*------------------------------------------------------------------------------
 351   Purpose:
 352     Notes:
 353 ------------------------------------------------------------------------------*/
 354
 355   DEF VAR key-value AS CHAR   NO-UNDO.
 356   DEF VAR curr-hdl  AS HANDLE NO-UNDO.
 357   DEF VAR done      AS LOGI   NO-UNDO.
 358   DEF VAR c-rec-src AS CHAR   NO-UNDO.
 359
 360   curr-hdl = THIS-PROCEDURE.
 361
 362   DO WHILE NOT done:
 363
 364     RUN get-link-handle IN adm-broker-hdl( curr-hdl, 'RECORD-SOURCE':U, OUTPUT c-rec-src ).
 365     curr-hdl = ?.
 366     ASSIGN curr-hdl = WIDGET-HANDLE( c-rec-src ) NO-ERROR.
 367
 368     IF VALID-HANDLE( curr-hdl ) THEN DO:
 369
 370       RUN get-attribute IN curr-hdl( 'Keys-Supplied' ).
 371       IF LOOKUP( key-name, RETURN-VALUE ) <> 0 THEN DO:
 372         RUN send-key IN curr-hdl( key-name, OUTPUT key-value ) NO-ERROR.
 373         done = NOT ERROR-STATUS:ERROR AND key-value <> ?.
 374       END.
 375     END.
 376     ELSE done = Yes.
 377
 378   END.
 379
 380   RETURN key-value.
 381
 382 END FUNCTION.
 383
 384 /* _UIB-CODE-BLOCK-END */
 385 &ANALYZE-RESUME
 386
 387 &ENDIF
 388