OS/2 Shareware BBS: Product/Product.zip/visilotu.zip/SAMPLE.PRG

Text File | 1995-11-17 | 19KB | 626 lines

!.HEADER
!
!
!
!    SAMPLE.PRG - Sample Program for Lotus Notes/Visualizer interface
!
!    IBM European Applications Support
!
!    C Interface written by Klaus-Peter Schlotter - IBM Germany
!    ASL Application written by Mike Cory - Decision Management Systems, Inc.
!    ASL Object Wrapper written by Matthew Perrins - EAS IBM UK
!
!.spec winsize MAX MAX
!.spec edit 1
!.spec textcol 0 17
!.spec appdest 1 d:\desktop\vis2lono\sample.apl
!.HEADER
!
! ON SELECT
! This block is triggered whenever the user selects a control
! or menu entry.
!
!
! ON START
! This block is executed when the program is initially invoked.
! It is normally used to initialize variables needed during
! program execution and to open the main window of the
! application.
!
ON START(FileName)
DO
  !
  ! Assign boolean variables
  LET yes = 1
  LET no  = 0
  !
  ! Assign all variables referred by the windows
  !
  LET CreateTableRC =""                           ! used by Text control named 'T.w_sample.TEXT4'
  LET GetFieldListRC =""                          ! used by Text control named 'T.w_sample.TEXT3'
  LET GetFormListRC =""                           ! used by Text control named 'T.w_sample.TEXT2'
  LET GetServerListRC =""                         ! used by Text control named 'T.w_sample.TEXT1'

  LET CurrentDirectory=""
  LET CurrentServer=""
  LET CurrentSelection=""
  !
  ! Call procedure to define data for list control(s)
  !
  CALL List_Define

  ! enable operating system calls
  OPEN SYSTEM Sys

  ! get profile data
  OPEN PROFILE Prof

  !
  OPEN WINDOW w_sample, , "I.Windows.sample"
  !
  ! assign the column titles for list controlLIST1
  LET T.w_sample.LIST1'COLTITLE1="Title_1"
  !
  ! assign the column titles for list controlLIST2
  LET T.w_sample.LIST2'COLTITLE1="Title_2"
  !
  ! assign the column titles for list controlLIST3
  LET T.w_sample.LIST3'COLTITLE1="Title_3"
  !
  ! assign the column titles for list controlLIST4
  LET T.w_sample.LIST4'COLTITLE1="Title_4"
  !
  ! assign the column titles for list controlLIST5
  LET T.w_sample.LIST5'COLTITLE1="Title_5"
  !
  ! assign the column titles for list controlLIST6
  LET T.w_sample.LIST6'COLTITLE1="Title_6"
  ! assign the column titles for list controlLIST7
  LET T.w_sample.LIST7'COLTITLE1="Title_7"

  LET T.w_sample.PUSH1[0]'ENABLED=No
  LET T.w_sample.PUSH2[0]'ENABLED=No
  LET T.w_sample.PUSH3[0]'ENABLED=No
  LET T.w_sample.PUSH4[0]'ENABLED=No

  LET OriginalTitle = W_Sample'TITLE
  LET W_Sample'TITLE = "Connecting to Lotus Notes..."

  OPEN LOTUSNOTES Lotus

  LET W_Sample'TITLE = OriginalTitle

  ! Define Current Position
  g_CurLoc = A.System.StartDs'Location
  IF Split(g_CurLoc,Length(g_CurLoc),1) = "\"
    g_CurLoc = Split(g_CurLoc,1,Length(g_CurLoc)-1)

END

ON SELECT
DO
  CASE A.System.Object
    !
    WHEN "T.w_sample.PUSH5"
    DO
      DEFINE ServerList[0]

      ! blank out these vectors
      DEFINE DirectoryList[0]                     ! vector to hold paths within server
      DEFINE FileList[0]                          ! vector to hold files (databases & directories) within server
      DEFINE FileInfoList[0]                      ! vector to hold details about files
      DEFINE FormList[0]                          ! vector to hold list of forms within database
      DEFINE FieldList[0]                         ! vector to hold fieldnames
      DEFINE FieldType[0]                         ! vector to hold type of field

      ! 'push' button marked 'GetServerList'
      CALL Lotus'GetServerList(POINTER(ServerList[0]))   ! pointer to ASL vector is required

    END

    WHEN "T.w_sample.PUSH1"
    DO

      ! 'push' button marked 'GetFileList'

      DEFINE DirectoryList[0]                     ! vector to hold paths within server
      DEFINE FileList[0]                          ! vector to hold files (databases & directories) within server
      DEFINE FileInfoList[0]                      ! vector to hold details about files

      ! blank out these vectors

      DEFINE FormList[0]                          ! vector to hold list of forms within database
      DEFINE FieldList[0]                         ! vector to hold fieldnames
      DEFINE FieldType[0]                         ! vector to hold type of field

      MODIFY Lotus,
        DIRECTORY = CurrentDirectory

      CALL Lotus'GetFileList( POINTER(DirectoryList[0]),
                              POINTER(FileList[0]),
                              POINTER(FileInfoList[0]))
    END
    !
    WHEN "T.w_sample.PUSH2"
    DO

      DEFINE FormList[0]                          ! vector to hold list of forms within database

      ! blank out these vectors
      DEFINE FieldList[0]                         ! vector to hold fieldnames
      DEFINE FieldType[0]                         ! vector to hold type of field

      ! 'push' button marked 'GetFormList'
      CALL Lotus'GetFormList( POINTER(FormList[0]) )                      ! pointer to ASL vector of forms
    END
    !
    WHEN "T.w_sample.PUSH3"
    DO

      DEFINE FieldList[0]                         ! vector to hold fieldnames
      DEFINE FieldType[0]                         ! vector to hold type of field

      IF NOVALUE(CurrentDirectory)
        LET FileName = Lotus'DATABASE
      ELSE
        LET FileName = FULLPATH(CurrentDirectory,Lotus'DATABASE)

      MODIFY Lotus,
        DATABASE = FileName

      ! 'push' button marked 'GetFieldList'
      CALL Lotus'GetFormFieldList( POINTER(FieldList[0]),
                                   POINTER(FieldType[0]))

      LET T.w_sample.PUSH4[0]'ENABLED=Yes

    END
    !
    WHEN "T.w_sample.PUSH4"
    DO
      ! 'push' button marked 'CreateTable'
      DEFINE SelList[0]                           ! define vector for QUERYCHECK on Listbox
      DEFINE SelCols[0]                           ! vector to hold selected fieldnames

      CALL T.W_Sample.LIST2'QUERYCHECK(SelList[0])! which columns are selected

      DO rr=1:SelList[0]'ENTRIES                  ! place the selected fieldnames
        INSERT SelCols[0]=FieldList[SelList[rr]]  ! in a vector for use below
      END

      IF SelCols[0]'ENTRIES=0                     ! if no columns were selected
      DO                                          ! then message the user and return
        ERROR 1,"You must first select 1 or more columns..."
        RETURN
      END

      DEFINE A.Lotus.ErrorInfo[0]              ! clear our messages vector


      CALL Lotus'CreateProductTable(
                  String("_\TEST.TAB",g_CurLoc),  ! Name Of Table To Create
                  POINTER(SelCols[0]))            ! pointer to ASL vector of selected fields

      ! Set result table to be deleted
      !
      LET TempTableName = String("_\TEST.TAB",g_Curloc)
      CALL Sys'INCLUDETEMP( TempTableName )           ! Delete file at application close


      ! Empty A.Lotus.ErrorInfo and then get the errors from the last call
      !
      DEFINE A.Lotus.ErrorInfo[0]
      CALL Lotus'GetErrorInfo(POINTER(A.Lotus.ErrorInfo[0]))
      !
      SHUT Test
      ! Open The Table
      OPEN TABLE Test,
        NAME     = "TEST.TAB",
        LOCATION = g_CurLoc,
        MODE = "READ"

      CALL Build_List("Test")                     ! call our own procedure to build Listbox dynamically

      MODIFY T.w_sample.LIST1,                    ! update the listbox to reflect
        COLDATA="TabColumns",                      ! updated columns vector
        EXPRESSION="TabLayout",                    ! layout vector
        COLTITLE1="Title_1"                        ! and titles vector

      LET CreateTableRc = TRIM(CreateTableRc)||"-" ||
        A.Lotus.ErrorInfo[0]'entries

    END
    !
    !
    WHEN "T.w_sample.LIST3"
    DO

      ! list box set for single select mode
      MODIFY Lotus,
        FORMNAME = FormList[A.System.BoxNumber]

      CurrentSelection = 'Form="'||Lotus'FORMNAME||'"'

      MODIFY Lotus,
        EXPRESSION = CurrentSelection

      LET T.w_sample.PUSH3[0]'ENABLED=Yes
      ! blank out these vectors
      DEFINE FieldList[0]                         ! vector to hold fieldnames
      DEFINE FieldType[0]                         ! vector to hold type of field

    END
    !
    !
    WHEN "T.w_sample.LIST5"
    DO

      ! list box set for single select mode
      MODIFY Lotus,
        SERVERNAME = ServerList[A.System.BoxNumber]

      LET T.w_sample.PUSH1[0]'ENABLED=Yes

      ! blank out these vectors
      DEFINE DirectoryList[0]                     ! vector to hold paths within server
      DEFINE FileList[0]                          ! vector to hold files (databases & directories) within server
      DEFINE FileInfoList[0]                      ! vector to hold details about files
      DEFINE FormList[0]                          ! vector to hold list of forms within database
      DEFINE FieldList[0]                         ! vector to hold fieldnames
      DEFINE FieldType[0]                         ! vector to hold type of field

    END

    WHEN "T.w_sample.LIST6"
    DO

      ! list box set for single select mode
      MODIFY Lotus,
        DATABASE = FileList[A.System.BoxNumber]

      LET T.w_sample.PUSH2[0]'ENABLED=Yes

      ! blank out these vectors
      DEFINE FormList[0]                          ! vector to hold list of forms within database
      DEFINE FieldList[0]                         ! vector to hold fieldnames
      DEFINE FieldType[0]                         ! vector to hold type of field

    END

  END
END

!
! Construct the arrays needed to support list controls
!
PROCEDURE List_Define
DO
  !
  ! Define data to handle list 'T.w_sample.LIST1'
  !
  DEFINE TabColumns[0]                            ! coldata vector
  DEFINE TabLayout[0]                             ! expression vector
  !
  ! fill the expression vector
  !
  INSERT TabLayout[0]="WIDTH=300 SEPARATOR=YES JUST=LEFT READONLY=YES"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE Documents[0]
  !
  ! fill the reference vector to point to these vectors
  !
  INSERT TabColumns[0] = "Documents"
  !
  ! create and fill the titles vector
  !
  DEFINE Title_1[0]
  INSERT Title_1[0] = "Documents"
  !
  ! Define data to handle list 'T.w_sample.LIST2'
  !
  DEFINE FldColumns[0]                            ! coldata vector
  DEFINE FldLayout[0]                             ! expression vector
  !
  ! fill the expression vector
  !
  INSERT FldLayout[0]="WIDTH=100 SEPARATOR=YES JUST=LEFT READONLY=YES"
  INSERT FldLayout[0]="WIDTH=60 SEPARATOR=YES JUST=LEFT READONLY=YES"
  INSERT FldLayout[0]="WIDTH=100 SEPARATOR=YES JUST=LEFT READONLY=YES"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE FieldList[0]
  DEFINE FieldType[0]
  DEFINE ColumnList[0]
  !
  ! fill the reference vector to point to these vectors
  !
  INSERT FldColumns[0] = "FieldList"
  INSERT FldColumns[0] = "FieldType"
  INSERT FldColumns[0] = "ColumnList"
  !
  ! create and fill the titles vector
  !
  DEFINE Title_2[0]
  INSERT Title_2[0] = "Name"
  INSERT Title_2[0] = "Type"
  INSERT Title_2[0] = "Column"
  !
  ! Define data to handle list 'T.w_sample.LIST3'
  !
  DEFINE ForColumns[0]                            ! coldata vector
  DEFINE ForLayout[0]                             ! expression vector
  !
  ! fill the expression vector
  !
  INSERT ForLayout[0]="WIDTH=200 SEPARATOR=YES JUST=LEFT READONLY=YES"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE FormList[0]
  !
  ! fill the reference vector to point to these vectors
  !
  INSERT ForColumns[0] = "FormList"
  !
  ! create and fill the titles vector
  !
  DEFINE Title_3[0]
  INSERT Title_3[0] = "Forms"
  !
  ! Define data to handle list 'T.w_sample.LIST4'
  !
  DEFINE DirColumns[0]                            ! coldata vector
  DEFINE DirLayout[0]                             ! expression vector
  !
  ! fill the expression vector
  !
  INSERT DirLayout[0]="WIDTH=100 SEPARATOR=YES JUST=LEFT READONLY=YES"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE DirectoryList[0]
  !
  ! fill the reference vector to point to these vectors
  !
  INSERT DirColumns[0] = "DirectoryList"
  !
  ! create and fill the titles vector
  !
  DEFINE Title_4[0]
  INSERT Title_4[0] = "Directories"
  !
  ! Define data to handle list 'T.w_sample.LIST5'
  !
  DEFINE FilColumns[0]                            ! coldata vector
  DEFINE FilLayout[0]                             ! expression vector
  !
  ! fill the expression vector
  !
  INSERT FilLayout[0]="WIDTH=100 SEPARATOR=YES JUST=LEFT READONLY=YES"
  INSERT FilLayout[0]="WIDTH=200 SEPARATOR=YES JUST=LEFT READONLY=YES"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE FileList[0]
  DEFINE FileInfoList[0]
  !
  ! fill the reference vector to point to these vectors
  !
  INSERT FilColumns[0] = "FileList"
  INSERT FilColumns[0] = "FileInfoList"
  !
  ! create and fill the titles vector
  !
  DEFINE Title_6[0]
  INSERT Title_6[0] = "File"
  INSERT Title_6[0] = "Details"

  !
  ! Define data to handle list 'T.w_sample.LIST6'
  !
  DEFINE SerColumns[0]                            ! coldata vector
  DEFINE SerLayout[0]                             ! expression vector
  !
  ! fill the expression vector
  !
  INSERT SerLayout[0]="WIDTH=100 SEPARATOR=YES JUST=LEFT READONLY=YES"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE ServerList[0]
  !
  ! fill the reference vector to point to these vectors
  !
  INSERT SerColumns[0] = "ServerList"
  !
  ! create and fill the titles vector
  !
  DEFINE Title_5[0]
  INSERT Title_5[0] = "Servers"

  !
  ! Define data to handle list 'T.w_sample.LIST7'
  !
  DEFINE MColumns[0]                              ! coldata vector
  DEFINE MLayout[0]                               ! expression vector
  !
  ! fill the expression vector
  !
  INSERT MLayout[0]="WIDTH=500 SEPARATOR=YES JUST=LEFT READONLY=YES"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE A.Lotus.ErrorInfo[0]
  !
  ! fill the reference vector to point to these vectors
  !
  INSERT MColumns[0] = "A.Lotus.ErrorInfo"
  !
  ! create and fill the titles vector
  !
  DEFINE Title_7[0]
  INSERT Title_7[0] = "Messages"
END
!
! ON QUIT
! This block is executed when the user uses Close in the
! system menu.
! For a secondary window this would imply, 'shut the window'.
! For a primary window the impication is, 'close the
! Application'.
!
ON QUIT
DO
  CASE A.System.Object

    WHEN "T..w_sample"                            ! primary window
      QUEUE PROGRAM A.System.ThisTask,STOP

    OTHERWISE
      SHUT ?A.System.Object

  END
END
!
! ERROR event
! This block is executed when there is a run-time error.
! You can trap errors here or allow the error message provided
! to identify the error and stop the program.
!

ON ERROR
DO
  !
  ! Message to identify failing module and line
  !
  LET ans=DIALOG("EFD7004",0,
   A.System.ErrorModule ,
   A.System.ErrorLine )

  DO i=1 : A.System.ErrorNumber[0]'ENTRIES

    IF ans = "CANCEL"
      TERMINATE

      ! Display system message corresponding to error
    LET ans = DIALOG ("EFD" ||
     A.System.Errornumber[i], 0,
     A.System.ErrorInfo[i])
  END

  SHUT Lotus

  STOP

END
!
! ON STOP
! This block is executed when the program is terminated.
! You should use the block to carry out any housekeeping
! required before closing
!
ON STOP
DO
  LET W_Sample'TITLE = "Disconnecting from Lotus Notes..."
  CALL W_Sample'REFRESH()

  SHUT Lotus

  STOP
END
!┌───────────────────────────────────────────────────────────────┐
!│You are recommended to use this box to provide a functional    │
!│description of the block.                                      │
!│In particular, you should note calls to and from the block, as │
!│well as noting any windows opened, and so on.                  │
!└───────────────────────────────────────────────────────────────┘

PROCEDURE Build_List(p_handle)
DO

  DEFINE ColList[0]

  FORGIVE
    CALL (?p_handle)'COLUMNS(ColList)             ! get list of columns

  IF A.System.ErrorNumber
    RETURN

  DEFINE TabColumns[0]                            ! COLDATA vector
  DEFINE TabLayout[0]                             ! EXPRESSION Vector
  DEFINE Title_1[0]                               ! COLTITLE vector
  DEFINE Width[0]                                 ! width for EXPRESSION vector
  DEFINE Just[0]                                  ! justification for EXPRESSION vector

  DO r=1:(?p_handle)'Columns                      ! build the vectors for LIST control
    LET ThisCol =                                 ! create full reference
     p_handle~"."~ColList[r]

    LET Type =                                    ! get column type
     (?ThisCol)'TYPE[0]

    INSERT TabColumns[0] =                        ! add to the COLDATA vector
     ThisCol~"[0]"

    INSERT Title_1[0]  =                          ! add to the COLTITLE vector
     ColList[r]

    LET ThisWidth=MAX((?ThisCol)'WIDTH[0],LENGTH(ColList[r]))

    INSERT width[0]   =                           ! width used in EXPRESSION vector
     ThisWidth

    INSERT Just[0]    =                           ! justification used in
     IF(Type="NUMERIC",                           ! EXRESSION vector
    "right",
     "left",
     "left")
  END

  DO r=1:(?p_handle)'Columns                      ! build the EXPRESSION vector
    INSERT TabLayout[0]=
     "WIDTH="~Width[r]*8~" SEPARATOR=yes JUST="~Just[r]
  END

  SHUT T.w_sample.LIST8                           ! shut the listbox

  OPEN LIST T.w_sample.LIST8,T..w_sample,         ! now re-open  it
   x          = T.w_sample.LIST1'X,               ! LIST1 will be hidden but we will
   y          = T.w_sample.LIST1'Y,               ! use its dimensions however it
   sizex      = T.w_sample.LIST1'sizeX,           ! exists in the Window editor
   sizey      = T.w_sample.LIST1'sizeY,
   COLDATA    = "TabColumns",
   EXPRESSION = "TabLayout",
   COLTITLE1  = "Title_1",
   HORZSCROLL = Yes,
   VERTSCROLL = Yes,
   VISIBLE    = Yes,
   ENABLED    = 3

  LET T.w_sample.LIST1'VISIBLE=No

END

ON DATA
DO
  CASE A.System.Object
    WHEN "T.W_SAMPLE.SLE1"
    DO
      MODIFY Lotus,
        EXPRESSION = CurrentSelection
    END
  END
END