function SRP_EDITOR_TEMP_POPUP_SUB_SYSPROG(void)

******************************************************************************
*
* This program is proprietary and is not to be used by or disclosed
* to others, nor is it to be copied without written permission from
* Revelation Technologies, Inc.
*
* Name       :  Popup_Sub
* Description:  This procedure implements the creation event for a Popup, and
*               is responsible for dynamically configuring the display of the
*               Popup to match the Popup's definition.
* See Also   :  Popup         (the remainder of the Popup functionality)
*               Popup_Equates (structure of the Popup definition)
*
* History    :  (date, initials, notes)
*   02/02/95  cp   Merged from Popup() and Popup_WinEvent()
*   03/30/95  vg   Fixed backcolor
*   04/04/95  vg   Added suppress blank lines and getfirstpage
*   05/04/95  vg   Fixing columns from a row ( aka MV support )
*   07/14/95  cp   Removing "@" properties, replacing with labelled common
*                  Adding the DataSet as a data source
*                  Replacing Get_ and Set_Property with PS_ versions
*                  Consolidating as many Get_ and Set_Properties as possible
*   01/17/96  cp   Sizing the popup window caused it to become visible; put
*                  the SIZE property at the end so make crisper appearance. 
*   03/27/96  cp   Disabling parent before calling Yield()
*   03/28/96  cp   Fixed C and F types (wrong variable used as file handle)
*   01/24/97  cp   Fixed multi-arg for DataSet type popups (was @vm, now @fm)
*   03/17/97  cp   Fixed truncation and empty title suffixes
*   06/17/97  cp   Disable ALL button until all results retrieved
*   06/17/97  cp   Added support for RGB structure vs. value; modified error
*                  handling to store/restore global status (search "Error:");
*                  retrieving extended error information for DataSet Popups
*
******************************************************************************

* external routines
declare function   PS_Get_Property, Get_Status, GetSystemMetrics, Repository
declare function   SendMessage, OpenNote, GetNoteField, EntID
declare subroutine Utility, Set_Status, RList, Make.List, Send_Event, Yield
declare subroutine PS_Set_Property, Popup, CloseNote, Post_Event
declare subroutine End_Dialog, End_Window, Send_Message

* insert records
$insert UIRes_Equates
$insert Popup_Equates
$insert ReposErrors
$insert PS_Equates
$insert DS_Equates
$insert XO_Equates
$insert Logical

* control ID's
equ ET_POPUP$           to  ".ET_POPUP"
equ CB_OK$              to  ".CB_OK"
equ CB_CANCEL$          to  ".CB_CANCEL"
equ CB_CLEAR$           to  ".CB_CLEAR"
equ CB_ALL$             to  ".CB_ALL"
equ CB_FIND$            to  ".CB_FIND"

* edit-table justifications
equ DTCS_LEFT$          to 0
equ DTCS_CENTER$        to 64
equ DTCS_RIGHT$         to 128
equ DTCS_HEADLEFT$      to 1024
equ DTCS_HEADCENTER$    to 256
equ DTCS_HEADRIGHT$     to 512
equ DTCS_LOCKED$        to 8192

* edit-table messages (assume that WM_USER is 1024)
equ DTM_GETDTMETRICS$   to  1120

* edit-table styles
equ DTS_HSCROLL$        to  1048576
equ DTS_VSCROLL$        to  2097152
equ DTS_ROWSELECT$      to  256
equ DTS_MULTIROW$       to  512
equ DTS_VGRID$          to  128
equ DTS_HGRID$          to  64
equ DTS_ROWBUTTONS$     to  8192
equ DTS_ROWNUMBERS$     to  16384
equ DTS_LARGEDATA$      to  4096
equ DTS_RESIZE$         to  8
equ DTS_OWNERDEF$       to  48
equ DTS_BORDER$         to  8388608

* edit-table metrics
equ DT_ROWHEIGHT$       to  1
equ DT_ROWWIDTH$        to  2
equ DT_HEADINGHT$       to  3
equ DT_LABELWIDTH$      to  4

* system metrics
equ SM_CXVSCROLL$       to  2
equ SM_CYHSCROLL$       to  3

* metrics for the popup window (all numbers should be even to avoid conversion problems to dialog units)
equ HMARGIN$            to  16           ;* left and right margins
equ VMARGIN$            to  16           ;* top and bottom margins
equ HBUTTON$            to  80           ;* button width
equ VBUTTON$            to  24           ;* button height
equ HBUTTONSPACE$       to  10           ;* horizontal button spacing (if on botton)
equ VBUTTONSPACE$       to  6            ;* vertical button spacing (if on right side)
equ HROWBUTTONEXTRA$    to  10           ;* extra width to add to row buttons (to pad numbers)
equ HROWBUTTONDFT$      to  14           ;* default button size (if no row numbers)

* misc
equ MAX_LIST_LEN$       to  65000
equ MAX_PAGE_ROWS$      to  100          ;* maximum number of rows per page (~80 @1600x1200)


*********************************
* parse the passed popup template
*********************************

* in case anyone calls this from the command-line
if @window # "POPUP" then return ""

* put up hourglass while we set up
Utility("CURSOR", "H")

TypeOverride = Popup_Struct@

* establish default POPUP record
Popup(@window, PopRec, "", PCMDDEFAULT$)

* stub in user changes in TypeOverride to PopRec
for i = 1 to PNUMFIELDS$
  if len(TypeOverride<i>) then
    PopRec<i> = TypeOverride<i>
  end
next i

* extract infromation about the popup into local variables
type       = PopRec<PTYPE$>
field      = PopRec<PFIELD$>
mode       = PopRec<PMODE$>
format     = PopRec<PFORMAT$>
file       = PopRec<PFILE$>
display    = PopRec<PDISPLAY$>
SelectMode = PopRec<PSELECT$>
cLocked    = PopRec<PLOCK$>

* format argument can not be null
ColCount = count(format, @vm) + (format # "")
if ColCount else
  Set_Status(TRUE$, POPUP_BADFORMAT$, field)
  goto Error
end

* parse format argument into separate variables
PopFields    = ""
PopWidths    = ""
PopJusts     = ""  ;* bit pattern, column and label edit-table justification
PopJustTypes = ""  ;* justification "L", "C", or "R"
PopOconvs    = ""
PopHeadings  = ""

* set up constants for calculating column can column header justification values   
equ JUST_CODES$  to "L,l,R,r,C,c"  ;* account for upper and lower case
equ JUST_DFT$    to DTCS_LEFT$
equ HJUST_DFT$   to DTCS_HEADLEFT$
just_equivs  = DTCS_LEFT$: @fm: DTCS_LEFT$: @fm: DTCS_RIGHT$: @fm: DTCS_RIGHT$: @fm: DTCS_CENTER$: @fm: DTCS_CENTER$
hjust_equivs = DTCS_HEADLEFT$: @fm: DTCS_HEADLEFT$: @fm: DTCS_HEADRIGHT$: @fm: DTCS_HEADRIGHT$: @fm: DTCS_HEADCENTER$: @fm: DTCS_HEADCENTER$

for i = 1 to ColCount
 * calculate the column justification value
  locate format<1,i,3> in JUST_CODES$ using "," setting pos then
    Just = Just_equivs<pos>
  end else
    Just = JUST_DFT$
  end

 * calculate the column header's justification value
  locate format<1,i,4> in JUST_CODES$ using "," setting pos then
    HJust = HJust_equivs<pos>
  end else
    HJust = HJUST_DFT$
  end 

 * check if the column is "scroll locked"
  if i <= cLocked and i < ColCount then
    LockAttr = DTCS_LOCKED$
  end else
    LockAttr = 0
  end

 * format information for the popup window (@svm delimited)
  PopJustTypes<1,1,i> = format<1,i,3>
  PopHeadings <1,1,i> = format<1,i,6>
  PopWidths   <1,1,i> = format<1,i,2>
  PopJusts    <1,1,i> = Just + HJust + LockAttr

 * store information on this column
  PopFields<1,i>     = format<1,i,1>
  PopOconvs<1,i>     = format<1,i,5>
next i

* store Popup information in common block
Popup_Struct@   = PopRec
Popup_ColCount@ = ColCount
Popup_Oconvs@   = PopOconvs
Popup_Fields@   = PopFields

begin case
  case type _EQC "F"
    if num(Field) and len(Field) else
      Set_Status(TRUE$, POPUP_BADFIELD$, field)
      goto Error
    end
    Popup_Type@  = Type
    Popup_Field@ = Field

  case type _EQC "K"
    Popup_Struct@<PTYPE$ > = "C"
    Popup_Struct@<PFIELD$> = 0
    Popup_Type@  = "F"
    Popup_Field@ = ColCount + 1

  case type _EQC "C"
    if len(Field) else
      Set_Status(TRUE$, POPUP_BADFIELD$, field)
      goto Error
    end
    Popup_Type@  = "F"
    Popup_Field@ = ColCount + 1

  case Type = "P"
    Popup_Type@  = "F"
    Popup_Field@ = ColCount + 1

  case OTHERWISE$
    Popup_Type@     = Type
    Popup_Field@    = Field
end case


**********************
* build the popup rows
**********************

EditTableList = ""     ;* list passed in create param for edit table control
List          = ""     ;* list set immediately after edit table created
RowCount      = 0
bRetrieve     = FALSE$

convert @lower.case to @upper.case in mode
Popup_Struct@<PMODE$> = mode

* if the popup gets its data from a file then open the file
locate mode in "T,C,K,R,F" using "," setting Pos then
  open File to fData else
    Set_Status(TRUE$, POPUP_BADFILE$, File)
    goto Error
  end
  open "DICT.": File to fDict else
    open "SYSDICT" to fDict else
      Set_Status(TRUE$, POPUP_BADFILE$, File)
      goto Error
    end
  end
  Popup_hFile@ = fData: @fm: fDict
end

* set up data or data retrieval based on the specified mode
locate mode in "D,N,L,T,C,K,R,F" using "," setting Pos then
  Error = FALSE$
  on Pos gosub DataSet, Notes, Literal, Table, Table, Table, Row, Field
  if Error then goto Error
end else
  Set_Status(TRUE$, POPUP_BADMODE$, mode)
  goto Error
end

if bRetrieve then
 * get at least one page of data to determine page size
  RowCount = 0
  List     = Popup(MAX_PAGE_ROWS$, RowCount, "", PCMDRETRIEVE$)
  begin case
    case RowCount = 0
     * no rows at all
      gosub popup_empty
      bRetrieve = FALSE$
    case RowCount < MAX_PAGE_ROWS$
     * no more rows to retrieve
      bRetrieve = FALSE$
  end case
end else
  if RowCount then 
   * data output formatting
    for col = 1 to ColCount
      if len(PopOconvs<1,col>) then
        conversion = PopOconvs<1,col>
        for row = 1 to RowCount
          EditTableList<row,col> = oconv(EditTableList<row,col>, conversion)
        next row
      end
    next col

   * add row number to end of each row if the number of the row is needed
    if Type _EQC "P" then
      col = ColCount + 1
      for row = 1 to RowCount
        EditTableList<row,col> = row
      next row
    end

    convert @fm:@vm to @svm:@tm in EditTableList
  end else
   * change title to explain no rows
    gosub popup_empty
  end
end


*************************
* set up the POPUP window
*************************

Props     = PS_Get_Property("SYSTEM": @rm: @window: @rm: @window: @rm: @window: ET_POPUP$: @rm: @window, "SIZE": @rm: "SIZE": @rm: "CLIENTSIZE": @rm: "HANDLE": @rm: "PARENT")

* get information on system sizes 
cxVScroll = GetSystemMetrics(SM_CXVSCROLL$)    ;* width of Vert Scroll bar
cyHScroll = GetSystemMetrics(SM_CYHSCROLL$)    ;* height of Horiz Scroll bar
Size      = field(Props, @rm, 1, 3)
convert @rm:@fm to @fm:@vm in Size
cxScreen  = Size<1,3>                          ;* width of screen
cyScreen  = Size<1,4>                          ;* height of screen
cxNonCli  = Size<2,3> - Size<3,1>
cyNonCli  = Size<2,4> - Size<3,2>

* default edit-table style
eTblStyle = DTS_LARGEDATA$

* get the average character size and other edit-table metrics based on the popup font
PS_Set_Property(@window: ET_POPUP$, "FONT", PopRec<PFONT$>)
cxChar   = PS_Get_Property(@window: ET_POPUP$, "FONT") <1,1,6> + 3
hWndET   = field(Props, @rm, 4) 
cyRow    = SendMessage(hWndET, DTM_GETDTMETRICS$, DT_ROWHEIGHT$, 0)
cyHead   = SendMessage(hWndET, DTM_GETDTMETRICS$, DT_HEADINGHT$, 0)

* start with a 0-size edit-table
cxeTbl    = 0
cyeTbl    = 0
bHScroll  = 0
bVScroll  = 0

* calculate width for row buttons
if PopRec<PROWBTN$> then
  if PopRec<PROWNUM$> then
    eTblStyle += DTS_ROWBUTTONS$ + DTS_ROWNUMBERS$
    cxRowBtn   = len( RowCount ) * cxChar + HROWBUTTONEXTRA$
    cxRowBtn   = int((cxRowBtn + 1) / 2) * 2           ;* round up to even number (since edit-table uses dialog units)
  end else
    eTblStyle += DTS_ROWBUTTONS$
    cxRowBtn   = HROWBUTTONDFT$
  end
end else
  cxRowBtn = 1         ;* bug in edit-table; if the button width is 0, the vscroll won't appear
end
cxeTbl += cxRowBtn

if PopRec<PWIDTH$> > 0 and PopRec<PWIDTH$> < ColCount then
  cVisCols = PopRec<PWIDTH$>
end else
  cVisCols = ColCount  ;* try to squeeze them all on
end

* calculate width of edit-table
for Col = 1 to ColCount
  CellLen = PopWidths<1,1,Col>
  HeadLen = len(PopHeadings<1,1,Col>)
  if CellLen >= HeadLen then
    cxCell = CellLen * cxChar
  end else
    cxCell = HeadLen * cxChar
  end
  cxCell   = int((cxCell + 1) / 2) * 2       ;* round up to even number (since edit-table uses dialog units)
  PopWidths<1,1,Col> = cxCell
  if Col <= cVisCols then
    cxeTbl += cxCell
  end
next Col

* determine if the edit-table is too big to fit on the screen (needs h-scroll bar)
gosub CheckForHScroll

* calculate height of heading
if PopRec<PCOLHDR$> then
  eTblStyle += DTS_OWNERDEF$
  cyeTbl    += cyHead
end

* calculate height of edit-table (assuming all rows visible)
bVScroll = (cyNonCli + cyeTbl +  RowCount * cyRow + 2 * VMARGIN$ + not(not(PopRec<PBTNSBELOW$>)) * (VMARGIN$ + VBUTTON$) > cyScreen)  ;* not(not()) insures TRUE=1 and FALSE=0
if bVScroll then
  eTblStyle += DTS_VSCROLL$
 * first, check if adding the v-scroll bar makes the edit-table too wide
 * (if HScroll already exists, the edit-table is already as wide as possible)
  if not(bHScroll) then
    cxeTbl += cxVScroll
    gosub CheckForHScroll
  end
 * determine how many rows to put on the screen
  cyButRows = cyNonCli + cyeTbl + 2 * VMARGIN$ + not(not(PopRec<PBTNSBELOW$>)) * (VMARGIN$ + VBUTTON$) ;* everything but the rows
  cVisRows  = int((cyScreen - cyButRows) / cyRow)
  if PopRec<PHEIGHT$> > 0 and PopRec<PHEIGHT$> < cVisRows then
    cVisRows  = PopRec<PHEIGHT$>
  end else
    cyButRows = cyNonCli + cyeTbl + 2 * VMARGIN$ + not(not(PopRec<PBTNSBELOW$>)) * (VMARGIN$ + VBUTTON$) ;* everything but the rows
    cVisRows  = int((cyScreen - cyButRows) / cyRow)
  end
  cyeTbl   += cVisRows * cyRow
end else
  if PopRec<PHEIGHT$> > 0 and PopRec<PHEIGHT$> < RowCount then
    cVisRows   = PopRec<PHEIGHT$>
    bVScroll   = TRUE$
    eTblStyle += DTS_VSCROLL$
    if bHScroll then
     * see if we can add the vscroll bar to the popup without exceeding screen size
     * (for example, if PopRec<PWIDTH$> forces display of a limited number of columns)
      if cxeTbl + cxVScroll < cxScreen - (cxNonCli + 2 * HMARGIN$ + not(PopRec<PBTNSBELOW$>) * (HMARGIN$ + HBUTTON$)) then
        cxeTbl += cxVScroll
      end
    end else
      cxeTbl += cxVScroll
      gosub CheckForHScroll
    end
  end else
    cVisRows = RowCount
  end
  cyeTbl += cVisRows * cyRow
end

* cyeTbl is in dialog units .. round up to closes dialog unit (2 pixels)
cyeTbl = int((cyeTbl + 2) / 2) * 2

* selection mode
begin case
  case SelectMode = 1                    ;* single selection
    eTblStyle += DTS_ROWSELECT$
  case SelectMode = 2                    ;* multi-selection
    eTblStyle += DTS_MULTIROW$
  case SelectMode = 3                    ;* ordered multi-selection
    eTblStyle += DTS_MULTIROW$
end case

* other optional edit-table styles
* note: not(not()) insures TRUE=1 and FALSE=0
* note: none of these affect the edit-table size
eTblStyle += DTS_BORDER$    * not(not(PopRec<PBORDER$>)) + DTS_RESIZE$ * not(not(PopRec<PRESIZE$>))
eTblStyle += DTS_HGRID$     * not(not(PopRec<PHGRID$> )) + DTS_VGRID$  * not(not(PopRec<PVGRID$> ))

* destroy the pre-existing edit-table
* note: this is done for speed (instead of adding individual columns) and
*       to allow non-modifiable styles to be modified (by destroying and re-creating)
Utility("DESTROY", @window: ET_POPUP$)

* determine which buttons are needed
AllButtons  = CB_OK$: @fm: CB_CANCEL$: @fm: CB_CLEAR$: @fm: CB_ALL$: @fm: CB_FIND$
cAllButtons = 5
ButtonList  = CB_OK$
if index("123", SelectMode, 1) then
  ButtonList<-1> = CB_CANCEL$
end
if SelectMode = 2 or SelectMode = 3 then
  ButtonList<-1> = CB_CLEAR$
end
if SelectMode = 2 then
  ButtonList<-1> = CB_ALL$
end
if PopRec<PSEARCH$> then
  ButtonList<-1> = CB_FIND$
end
cButtons = count(ButtonList, @fm) + 1
  
* determine location and size of button row
bButtonsBelow = PopRec<PBTNSBELOW$>
if bButtonsBelow then
  yButton     = VMARGIN$ + cyeTbl + VMARGIN$                                                ;* button row position
  cxButtonRow = HMARGIN$ + HBUTTON$ * cButtons + HBUTTONSPACE$ * (cButtons - 1) + HMARGIN$  ;* width of button row
  cyButtonCol = 0                                                                           ;* buttons aren't in a column
end else
  xButton     = HMARGIN$ + cxeTbl + HMARGIN$                                                ;* button column position
  cxButtonRow = 0                                                                           ;* buttons aren't in a row
  cyButtonCol = VMARGIN$ + VBUTTON$ * cButtons + VBUTTONSPACE$ * (cButtons - 1) + VMARGIN$  ;* height of button column
end

* calculate size and position of the popup dialog based on edit-table size
cxDialog  = HMARGIN$ + cxeTbl + HMARGIN$ +     not(PopRec<PBTNSBELOW$>)  * (HMARGIN$ + HBUTTON$)
cyDialog  = VMARGIN$ + cyeTbl + VMARGIN$ + not(not(PopRec<PBTNSBELOW$>)) * (VMARGIN$ + VBUTTON$)

* check if buttons affect the dialog size
if cxButtonRow > cxDialog then
  cxDialog = cxButtonRow
end
if cyButtonCol > cyDialog then
  cyDialog = cyButtonCol
end

* account for the title bar and dialog border
cxDialog += cxNonCli
cyDialog += cyNonCli

* calculate position for the dialog
OwnerWindow = field(Props, @rm, 5)
OwnerSize   = PS_Get_Property(OwnerWindow, "SIZE")
begin case
  case OwnerWindow = "" or OwnerSize = "" or PopRec<PCOL$> = -2 or PopRec<PROW$> = -2    ;* center w.r.t. screen
    xDialog = (cxScreen - cxDialog) / 2
    yDialog = (cyScreen - cyDialog) / 2
  case PopRec<PCOL$> = -1 or PopRec<PROW$> = -1   ;* center w.r.t. OwnerWindow
    xDialog = OwnerSize<1> + (OwnerSize<3> - cxDialog) / 2
    yDialog = OwnerSize<2> + (OwnerSize<4> - cyDialog) / 2
  case 1                                          ;* position w.r.t. OwnerWindow
    xDialog = OwnerSize<1> + PopRec<PCOL$>
    yDialog = OwnerSize<2> + PopRec<PROW$>
end case

* make sure that the popup is on the screen
if xDialog < 0 then
  xDialog = 0
end
if yDialog < 0 then
  yDialog = 0
end
if xDialog + cxDialog > cxScreen then
  xDialog = cxScreen - cxDialog
end
if yDialog + cyDialog > cyScreen then
  yDialog = cyScreen - cyDialog
end

* move and size the popup window
CtrlList  = @window
PropList  = "TEXT"
ValueList = PopRec<PTITLE$>

* if the buttons are on the bottom, center them based on the new dialog size
xFirstButton = (cxDialog - cxButtonRow) / 2

* move and size the buttons (deleting unused)
for i = 1 to cAllButtons
  locate AllButtons<i> in ButtonList using @fm setting pos then
    if bButtonsBelow then
     * button goes on the bottom
      xButton = xFirstButton + (pos - 1) * (HBUTTONSPACE$ + HBUTTON$)
    end else
     * button goes on the right side
      yButton = VMARGIN$ + (pos - 1) * (VBUTTONSPACE$ + VBUTTON$)
    end 
    CtrlList  := @rm: @window: AllButtons<i>
    PropList  := @rm: "SIZE"
    ValueList := @rm: xButton: @fm: yButton: @fm: HBUTTON$: @fm: VBUTTON$
  end else
    Utility("DESTROY", @window: AllButtons<i>)
  end
next i

* invisible columns are used for return values (#1) and for ordered multi-selections (#2)
if (SelectMode and Type _NEC "R" and Type _NEC "E") or (SelectMode = 3) then
  ExtraCol   = 1 + (SelectMode = 3)
  ExtraCh    = str(@svm: 132, ExtraCol)
  ExtraWide  = str(@svm: 0  , ExtraCol)
  ExtraStyle = str(@svm: 32, ExtraCol)
end else
  ExtraCol   = FALSE$
  ExtraCh    = ""
  ExtraWide  = ""
  ExtraStyle = ""
end

* determine if color is RGB value or structure
Color = PopRec<PBKCOLOR$>
if index(Color, @vm, 1) then
 * @vm delimited structure of red, green, and blue values, each 0..255
  Color = Color<1,1> + Color<1,2> * 256 + Color<1,3> * 65536
end

* create the edit-table
eTbl = ""
eTbl<1,PSPOS_NAME$>      = @window: ET_POPUP$
eTbl<1,PSPOS_TYPE$>      = PSCTL_EDITTABLE$
eTbl<1,PSPOS_PARENT$>    = @window
eTbl<1,PSPOS_X$>         = HMARGIN$
eTbl<1,PSPOS_Y$>         = VMARGIN$
eTbl<1,PSPOS_WIDE$>      = cxeTbl
eTbl<1,PSPOS_HIGH$>      = cyeTbl
eTbl<1,PSPOS_ENABLED$>   = 1
eTbl<1,PSPOS_VISIBLE$>   = 1
eTbl<1,PSPOS_SDKSTYLE$>  = eTblStyle 
eTbl<1,PSPOS_PSSTYLE$>   = 4     ;* initial focus
eTbl<1,PSPOS_TAB$>       = @window: ButtonList<cButtons>
eTbl<1,PSPOS_BKCOLOR$>   = Color
eTbl<1,PSPOS_LOGFONT$>   = PopRec<PFONT$> 
eTbl<1,PSPOS_LIST$>      = EditTableList
eTbl<1,PSPOS_NUMCOLS$>   = ColCount + ExtraCol
eTbl<1,PSPOS_ROWLIMIT$>  = RowCount
eTbl<1,PSPOS_COLSTYLES$> = PopJusts: ExtraStyle
eTbl<1,PSPOS_COLWIDE$>   = cxRowBtn: @svm: PopWidths: ExtraWide
eTbl<1,PSPOS_EVENTS$>    = PSEVENT_CLICK$: @svm: PSEVENT_DBLCLK$
eTbl<1,PSPOS_LABEL$>     = PopHeadings
eTbl<1,PSPOS_CHARCOUNT$> = str(@svm:132, ColCount) [2,999]: ExtraCh
Utility("CREATE", eTbl)
Popup_hWndET@ = PS_Get_Property(@window: ET_POPUP$, "HANDLE")

* instead of putting list in create param for the edit table control, it is
* set now because the create param requires @svm/@tm delim which would destroy
* any return data that had @svm's or @tm's
if len(List) then
  CtrlList  := @rm: @window: ET_POPUP$
  PropList  := @rm: "LIST"
  ValueList := @rm: List
end

if Popup_Struct@<PINITSELECT$> then
  CtrlList  := @rm: @window: ET_POPUP$
  PropList  := @rm: "SELPOS"
  ValueList := @rm: 1: @fm: Popup_Struct@<PINITSELECT$>

  if Popup_Struct@<PSELECT$> = 3 then
    cItems = count(Popup_Struct@<PINITSELECT$>, @vm) + (Popup_Struct@<PINITSELECT$> # "")
    for iItem = 1 to cItems
      CtrlList  := str(@rm: @window: ET_POPUP$, 2)
      PropList  := @rm: "ACCESSPOS": @rm: "ACCESSDATA"
      ValueList := @rm: Popup_ColCount@ + 2: @fm: Popup_Struct@<PINITSELECT$,iItem>: @rm: iItem
    next iItem
    Popup_ClickPos@<4> = cItems + 1
  end
end

* if all rows are not already retrieved, disable "select all" button
if bRetrieve then
  CtrlList  := @rm: @window: CB_ALL$
  PropList  := @rm: "ENABLED"
  ValueList := @rm: FALSE$
end

* set window title and make the window visible
CtrlList  := @rm: @window                                            : @rm: OwnerWindow
PropList  := @rm: "SIZE"                                             : @rm: "ENABLED"
ValueList := @rm: xDialog: @fm: yDialog: @fm: cxDialog: @fm: cyDialog: @rm: FALSE$

PS_Set_Property(CtrlList, PropList, ValueList)

* change back to arrow cursor
Utility("CURSOR", "A")

* retrieve any pending rows
if bRetrieve then
  Window = @window
  loop
    List = Popup(cVisRows, RowCount, "", PCMDRETRIEVE$)
  while len(List)
   * append a page's worth of data
    Send_Message(Window: ET_POPUP$, "INSERT", -1, List)
    Yield()
  while PS_Get_Property(Window, "HANDLE")
  repeat

  if PS_Get_Property(Window, "HANDLE") then
    PS_Set_Property(Window: CB_ALL$, "ENABLED", TRUE$)
  end
end

return 0


** internal routines **


************************
* is horiz-scroll needed
************************
CheckForHScroll:
  if PopRec<PWIDTH$> > 0 and PopRec<PWIDTH$> < ColCount then
    bHScroll = TRUE$
   * add scroll bar style to edit-table
    eTblStyle += DTS_HSCROLL$
   * add scroll bar height to edit-table
    cyeTbl += cyHScroll
  end else
    bHScroll = (cxNonCli + cxeTbl + 2 * HMARGIN$ + not(PopRec<PBTNSBELOW$>) * (HMARGIN$ + HBUTTON$) + bVScroll * cxVScroll > cxScreen)
    if bHScroll then
      eTblStyle += DTS_HSCROLL$
     * ues as much screen as possible (not counting the buttons and the margins) for edit-table
      cxeTbl  = cxScreen - (cxNonCli + 2 * HMARGIN$ + not(PopRec<PBTNSBELOW$>) * (HMARGIN$ + HBUTTON$))
      cxeTbl  = int((cxeTbl + 1) / 2) * 2  ;* round up to even number (since edit-table uses dialog units)
     * add scroll bar height to edit-table
      cyeTbl += cyHScroll
    end
  end
return


****************
* error handling
****************
Error:
 * store error
  if Get_Status(StatX) then
    Restore = TRUE$
    Set_Status(FALSE$)
  end

  Send_Event(@window, "CLOSE")

 * restore error
  if Restore then
    Set_Status(TRUE$, StatX)
  end

  return 0


****************************
* add message to popup title
****************************
Popup_Truncated:
  PopRec<PTITLE$> = PopRec<PTITLE$>: ResToString(UIRES_TRUNCATED$, UIRES_SYSTEM$)
return

Popup_Empty:
  PopRec<PTITLE$> = PopRec<PTITLE$>: ResToString(UIRES_EMPTY$, UIRES_SYSTEM$)
return


**************
* DataSet data
**************
DataSet:
  DSName = Popup_Struct@<PFILE$,1>
  hDS    = Popup_Struct@<PFILE$,2>
  XOName = Popup_Struct@<PSUBFILE$,1>
  hXO    = Popup_Struct@<PSUBFILE$,2>
  Args   = Popup_Struct@<PDISPLAY$>

 * ConInfo <1>=ds <2>=xo; <n,1>=name <n,2>=handle <n,3>=owned (created by Popup)
  Popup_ConInfo@<1,1> = DSName
  Popup_ConInfo@<1,2> = hDS
  Popup_ConInfo@<1,3> = FALSE$
  Popup_ConInfo@<2,1> = XOName
  Popup_ConInfo@<2,2> = hXO
  Popup_ConInfo@<2,3> = FALSE$

 * if a DataSet was not passed then create it
  if hDS then
   * verify that the DataSet is value
    Flag = DSGetProperty(hDS, DS_VALID$, Valid)
    if not(Valid) then
      Set_Status(TRUE$, "Passed DataSet handle (": hDS: ") is invalid")
      Error = TRUE$
      return
    end
  end else
   * if a Connection was not passed then create it
    if hXO then
      Flag = XOGetProperty(hXO, XO_VALID$, Valid)
      if not(Valid) then
        Set_Status(TRUE$, "Passed Connection Object handle (": hXO: ") is invalid")
        Error = TRUE$
        return
      end
    end else
     * get the Connection name from the subkey of the DataSet
      if len(XOName) else
        XOName = Repository("GETSUBKEY", EntID("", DS_TYPE$, DS_CLASS$, DSName))
      end

      XOMethod("", XO_GETERROR$)
      hXO = XOInstance(XOName)
      if hXO then
        Popup_ConInfo@<2,2> = hXO
        Popup_ConInfo@<2,3> = TRUE$
      end else
        XOMethod("", XO_GETERROR$, "", "", "", "", Text)
        if len(Text) then
          convert @vm to "|" in Text
          Text = "||": Text
        end

        if len(XOName) then
          Set_Status(TRUE$, "Unable to connect to ": quote(XOName): ".": Text)
        end else
          Set_Status(TRUE$, "Unable to create connection.": Text)
        end
        Error = TRUE$
        return
      end
    end

   * create the DataSet
    DSMethod("", DS_GETERROR$)
    hDS = DSInstance(DSName, hXO)
    if hDS then
      Popup_ConInfo@<1,2> = hDS
      Popup_ConInfo@<1,3> = TRUE$
    end else
      DSMethod("", DS_GETERROR$, "", "", "", "", Text)
      if len(Text) then
        convert @vm to "|" in Text
        Text = "||": Text
      end
      Set_Status(TRUE$, "Unable to create DataSet ": quote(DSName): ".": Text)
      Error = TRUE$
      return
    end

   * set the retrieval arguments
    if len(Args) then
      ArgList  = ""
      ArgVals  = ""
      if index(Args, @vm, 1) then
        ArgCount = count(Args<1,2>, @svm) + (Args<1,2> # "")
        for iArg = 1 to ArgCount
          ArgList<1,iArg> = Args<1,2,iArg>
          ArgVals<iArg  > = Args<1,1,iArg>
        next iArg
      end else
        ArgCount = count(Args<1,1>, @svm) + (Args<1,1> # "")
        for iArg = 1 to ArgCount
          ArgList<1,iArg> = iArg
          ArgVals<iArg  > = Args<1,1,iArg>
        next iArg
      end
      Flag = DSSetProperty(hDS, DS_ARG$, ArgVals, ArgList)
      if not(Flag) then
        Set_Status(TRUE$, "Unable to set DataSet arguments")
        Error = TRUE$
        return
      end
    end

   * convert column names to numbers (for performance reasons)
    Flag = DSGetProperty(hDS, DS_COLID$, Popup_Fields@, Popup_Fields@:"")
    if Flag and Popup_Struct@<PTYPE$> = "C" then
      Flag = DSGetProperty(hDS, DS_COLID$, Temp, Popup_Struct@<PFIELD$>)
      Popup_Struct@<PFIELD$> = Temp
    end
    if not(Flag) then
      Set_Status(TRUE$, "Unable to verify DataSet column ID's")
      Error = TRUE$
      return
    end

   * execute the DataSet
    Flag = DSMethod(hDS, DS_EXECUTE$)
    if not(Flag) then
      DSMethod(hDS, DS_GETERROR$, "", "", "", "", Text)
      if len(Text) then
        convert @vm to "|" in Text
        Text = "||": Text
      end

      Set_Status(TRUE$, "Unable to execute DataSet.": Text)
      Error = TRUE$
      return
    end
  end

  bRetrieve = TRUE$
return


******************
* Lotus Notes data
******************
Notes:
 * for Lotus Notes, File is as follows:
 * <1,1> database name
 * <1,2> "NOTESFORM" or "NOTESVIEW"
 * <1,3> @svm-delim list of forms/views
 * <1,4> @tm-delim list of fields/columns corresponding to @svm-delim form/view
 * display is either "USE view", a select script for LINEAR search, or the "searchinfo"
 * parameter for the OpenNote function (with @vm's instead of @fm's)

  begin case
   * searchinfo structure can be passed in display
    case index(Display, @vm, 1)
      convert @vm to @fm in Display

   * view criteria starts with the keyword "Use" followed by the view name
    case display [1,4] _EQC "USE "
      convert @tm to " " in display
      View   = field(trim(Display), " ", 2)
      SubKey = Repository("GETSUBKEY", EntID(@appid<1>, "DBCOMPONENT", "NOTESVIEW", View))
      Display = "INDEXED": @fm: field(SubKey, "#", 2)

   * standard search criteria
    case OTHERWISE$
      convert @tm to " " in display
      Display = "LINEAR": @fm: Display
  end case

  * get database name
  Database = Repository("GETSUBKEY", EntID(@appid<1>, "DATASOURCE", "NOTESDB", File<1,1>))
  convert "#" to @fm in Database
  if len(Database) else
    Set_Status(TRUE$, "Database ": quote(File<1,1>): " has not been registered")
    Error = TRUE$
    return
  end

  * select the note id's to display
  if OpenNote(Database, Display, Popup_OpenDocIDs@) then
    if len(Popup_OpenDocIDs@) then
      bRetrieve = TRUE$
    end
  end
return


**************
* literal data
**************
Literal:
 * data in the "display" variable
  EditTableList = display
  convert @vm:@svm to @fm:@vm in EditTableList
  RowCount = count(EditTableList, @fm) + (EditTableList # "")
return


*******************
* data is in a file
*******************
Table:
 * build a list of keys
  begin case
    case mode _EQC "T"
     * remove text marks (design-time formatting of criteria)
      convert @tm to " " in display
     * use RList to select records in the file
      RList("SELECT ": file: " ": display, 5, "", "", 0)
      if Get_Status() then
        Error = TRUE$
        return
      end
      Popup_KeyList@ = 0           ;* cursor 0

    case mode _EQC "C"
     * user has an active cursor (has to be cursor 0 because
     * "readnext key,value" only uses cursor 0)
      if len(Display) and num(Display) then
        Popup_KeyList@ = Display   ;* cursor is specified by Display
      end else
        Popup_KeyList@ = 0         ;* assume cursor 0
      end

    case mode _EQC "K"
      Popup_KeyList@ = display
      convert @vm to @fm in Popup_KeyList@
  end case

  bRetrieve = TRUE$
return


******************************
* Columns from a specified row
******************************
Row:
 * the data file has been opened to Popup_hFile@
 * the record key is in display
  fData = Popup_hFile@<1>

 * read the record 
  read rec from fData, display else
    Set_Status(TRUE$, POPUP_BADKEY$, display: @vm: file)
    Error = TRUE$
    return
  end
  convert @tm to "" in rec   ;* consistent display with Arev

  for col = 1 to ColCount
    if num(PopFields<1,col>) and len(PopFields<1,col>) then
     * build the display data
      FieldVal = Rec<Popfields<1,Col>>
     * only count the number of rows (in the popup) for the first column
      if Col = 1 then
        RowCount = count(FieldVal, @vm) + (FieldVal # "")
      end
      for Row = 1 to RowCount
       * add each value of this field to the display record
        EditTableList<row, Col> = rec<PopFields<1,col>, row, 1>
      next Row
    end else
      Set_Status(TRUE$, POPUP_NONNUM_FIELD$, PopFields<1,col>)
      Error = TRUE$
      return
    end
  next col        
return


*****************************
* Column from a specified row
*****************************
Field:
 * the data file has been opened to Popup_hFile@
 * the record key is in "display<1,1>"
 * the column number to get the data from is in "display<1,2>"
  fData = Popup_hFile@<1>
  key   = display<1,1>
  col   = display<1,2>

 * verify that the column number is a number and is positive 
  if not(num(col)) or (col <= 0) then
    Set_Status(TRUE$, POPUP_BADFIELD$, col)
    Error = TRUE$
    return
  end

 * read the data to display 
  read rec from fData, key else
    Set_Status(TRUE$, POPUP_BADKEY$, key: @vm: file)
    Error = TRUE$
    return
  end

 * only getting data from one row
  rec = rec<col>
  RowCount = count(rec, @vm) + (rec # "")

 * verify that the field names in the format argument are all
 * numeric 
  if num(field) and len(field) else
    Set_Status(TRUE$, POPUP_NONNUM_FIELD$, field)
    Error = TRUE$
    return
  end
  for col = 1 to ColCount
    if num(PopFields<1,col>) and len(PopFields<1,col>) else
      Set_Status(TRUE$, POPUP_NONNUM_FIELD$, PopFields<1,col>)
      Error = TRUE$
      return
    end
  next col        

 * build the display data
  for row = 1 to RowCount
    for col = 1 to ColCount
      EditTableList<row,col> = rec<1,row,PopFields<1,col>>
    next col
  next row
return