!+
!----------------------------------------------------------------------------
! SD_MENU.SCP
!
! Display Shared Document Library Menu for selected library.
!
! Calling this script from named data: GET #SD_LIB="library"\DO SD_MENU
!                     interractively:  <DO SD_MENU   (prompts for library)
!----------------------------------------------------------------------------
!-
.LABEL START
!+
! Get library name  (#SD_LIB)
!-
    .IF #SD_LIB NES "" THEN .GOTO HAVE_LIBNAME
    .CLEAR 24
    .PROMPT 24,"Shared library name: "
    .CLEAR 24
    .IF OA$SCRIPT_TEXT NES "" THEN GET #SD_LIB = OA$SCRIPT_TEXT ELSE .EXIT
.LABEL HAVE_LIBNAME
!+
! Is user authorized to edit shared documents?  (set symbol #SD_EDIT)
!-
    .GOTO SET_EDIT_FLAG
.LABEL SEF_RETURN
!+
! Define logical SHARED_LIBRARY to point to shared library
!-
    GET #SD_LOGNAM="SHARED_" #SD_LIB
    GET OA$FUNCTION="GET #SD_LOGVAL=LOG$" #SD_LOGNAM
    .IF #SD_LOGVAL NES "" THEN .GOTO HAVE_LOGICAL
    .CLEAR 24
    .TEXT 24,"Logical " #SD_LOGNAM " not defined. "
    .PAUSE 3
    .CLEAR 24
    GET #SD_LIB=""
    .EXIT
.LABEL HAVE_LOGICAL
    GET OA$FUNCTION="LOGICAL SHARED_LIBRARY," #SD_LOGNAM
!+
! Get library description to display on menu  (#SD_LIB_DESC)
!-
    GET OA$FUNCTION="GET #SD_LIB_DESC=LOG$" #SD_LOGNAM "_DESC"
    .IF #SD_LIB_DESC EQS "" THEN GET #SD_LIB_DESC = #SD_LIB
    GET #S=#SD_LIB_DESC\GET #L=31\DO CENTER\GET #SD_LIB_DESC=#S
!+
! Get current document name for this library
!-
    GET #SD_SYMBOL = "$CURDOC_" #SD_LIB
    GET #SD_CURDOC = @#SD_SYMBOL
    .IF #SD_CURDOC NES "" THEN .GOTO HAVE_CURDOC
    .REMARK If $CURDOC_library not set, give them a current document
    GET #SD_CURDOC = OA$DIR:"SHARED_LIBRARY:*.WPL;".%NEXT[""]\
    GET #SD_CURDOC = OA$DIR.NAME[#SD_CURDOC]
.LABEL HAVE_CURDOC
!+
! Display the menu 
!
! Note: the /POST form qualifier doesn't really work the way you would think.
!	It is actually processed BEFORE the form is displayed, AND every time
!	the form is repainted.  In fact, I don't see that it's any different
!	than /PRE!
!-
    FORM SD_MENU/POST='GET @#SD_SYMBOL=#SD_CURDOC'
!+
! That's all Folks
!-
    GET #SD_LIB=""
    .EXIT
!+
!-----------------------------------------------------------------------------
! SET_EDIT_FLAG subroutine
!
! Determine if this user is authorized to edit/delete/rename documents in
! this shared library (#SD_LIB).  Logical SHARED_LIBS contains a list of
! libraries (e.g. "Records,Task") that this user has access to.  Symbol
! #SD_EDIT is set to "Y" if this user has edit authorization.
!
! Note: SHARED_LIBS translation must not contain any spaces.
!
! Man, I sure wish All-in-1 had some string handling functions!
!-----------------------------------------------------------------------------
!-
.LABEL SET_EDIT_FLAG
    .IF #SD_LIB EQS "" THEN .GOTO DENY_ACCESS_NODEF
    GET #SHARED_LIBS = LOG$SHARED_LIBS
    GET #W_OFFSET = #C_OFFSET = 0
!+
! Parse #SHARED_LIBS into individual library names
!-
.LABEL WORD_LOOP
    GET #LENGTH = 0
.LABEL CHAR_LOOP
    .REMARK If current char is "," or " " then we're at the end of a word
    GET OA$FUNCTION="GET #C = #SHARED_LIBS:1:" #C_OFFSET
    .IF #C EQS "," OR #C EQS " " THEN .GOTO HAVE_NAME
    COMPUTE #LENGTH = #LENGTH + 1
    COMPUTE #C_OFFSET = #C_OFFSET + 1
    .GOTO CHAR_LOOP
!+
! Compare the substring we've just found with the library name
!-
.LABEL HAVE_NAME
    GET OA$FUNCTION="GET #LIB = #SHARED_LIBS:" #LENGTH ":" #W_OFFSET
    .IF #LIB EQS #SD_LIB THEN .GOTO GRANT_ACCESS
    .REMARK IF character is " " then we've searched the whole list
    .IF #C EQS " " THEN .GOTO DENY_ACCESS
    COMPUTE #C_OFFSET = #W_OFFSET = #W_OFFSET + #LENGTH + 1
    .GOTO WORD_LOOP
!+
! This user is authorized to edit/delete/rename shared documents.
!-
.LABEL GRANT_ACCESS
    GET #SD_EDIT = "Y"
    .GOTO SEF_EXIT
!+
! This user is only authorized to READ shared documents.
! Note that VMS file protections ultimately determine access.
!-
.LABEL DENY_ACCESS_NODEF
    DISPLAY ERROR - #SD_LIB not defined
.LABEL DENY_ACCESS
    GET #SD_EDIT = "N"
    .GOTO SEF_EXIT
!+
! Subroutine exit
!-
.LABEL SEF_EXIT
    .GOTO SEF_RETURN