Expand the function FILESPEC

 
/* sample code to extend the FILESPEC function with code to extract   */
/* the extension of a fileName                                        */

  do until myInput = ""
    say "New options for FILESPEC are:"                      /* v2.30 */
    say "-----------------------------"                      /* v2.30 */
    say "E - return the extension of the file"               /* v2.30 */
    say "B - return the name without the extension of the file"  /* " */
    say "H - return the drive & path of the file"            /* v2.30 */
    say "-----------------------------"                      /* v2.30 */
    say "Enter the parameter for FILESPEC(option, fileName): "
    myInput = strip( lineIn() )
    if myInput <> "" then
    do
      parse var myInput myOption "," myfileName
      say "The result of FILESPEC( " myOption "," myfileName ") is: "
      say "<" || fileSpec( myOption, myfileName ) || ">"
    end /* if myInput <> "" then */
  end /* do until myInput = "" */

exit 0

/* ------------------------------------------------------------------ */
/* function: Extended FILESPEC function                               */
/*                                                                    */
/* call:     FileSpec option,fileName                                 */
/*                                                                    */
/* where:    option                                                   */
/*                                                                    */
/*             - E{xtension}                                          */
/*               return the extension of the file                     */
/*                                                                    */
/*             - B{asename}                                           */
/*               returns the name of the file without extension       */
/*                                                                    */
/*             - H{ome]                                               */
/*               returns the fully qualified path of the file         */
/*               (including the drive specifier; without the trailing */
/*               backslash)                                           */
/*                                                                    */
/*             All other values for "option" are processed by the     */
/*             original FILESPEC function.                            */
/*                                                                    */
/*           fileName                                                 */
/*             - name of the file                                     */
/*                                                                    */
/* returns:  if option = E{xtension}:                                 */
/*             the extension of the fileName or "" if none            */
/*           else                                                     */
/*             if option = B{asename}:                                */
/*               the name of the file without the path and extension  */
/*             else                                                   */
/*               the return code of the original FILESPEC function    */
/*               or "SYNTAX ERROR" if called with invalid parameter   */
/*                                                                    */
/* note:     To call the original FILESPEC function directly, use     */
/*             myResult = "FILESPEC"( option, fileName )              */
/*                                                                    */
/* history:                                                           */
/*           RXT&T v1.90 /bs                                          */
/*            - added the option B{asename}                           */
/*           RXT&T v2.30 /bs                                          */
/*            - added the option H{ome}                               */
/*                                                                    */
FileSpec: PROCEDURE
  parse arg option, fileName

                        /* init the return code                       */
  rc = "SYNTAX ERROR"
                        /* install a local error handler              */

  SIGNAL ON SYNTAX NAME FileSpecError

  fileName = strip( fileName )                               /* v2.30 */
  option = translate( strip( option ) )

                        /* check the option code                      */
  select

    when abbrev( "EXTENSION", option ) = 1 then
    do
                        /* process the new added option code          */
      i = lastPos( ".", fileName )
      if i > lastPos( "\", fileName ) then
        rc = substr( fileName, i+1 )
      else
        rc = ""
    end /* when */

    when abbrev( "BASENAME", option ) = 1 then               /* v1.90 */
    do                                                       /* v1.90 */
                        /* call the original FILESPEC function  v1.90 */
                        /* to get the filename                  v1.90 */
      rc = "FILESPEC"( "N", fileName )                       /* v1.90 */
      i = lastpos( ".", rc )                                 /* v1.90 */
      if i <> 0 then                                         /* v1.90 */
        rc = substr( rc,1, i-1 )                             /* v1.90 */
    end /* when */                                           /* v1.90 */

    when abbrev( "HOME", option ) = 1 then                   /* v2.30 */
    do                                                       /* v2.30 */
      rc = "FILESPEC"( "D", fileName ) ||,                   /* v2.30 */
           "FILESPEC"( "P", fileName )                       /* v2.30 */
      if right( rc,1 ) = "\" then                            /* v2.30 */
        rc = dbrright( rc,1 )                                /* v2.30 */
    end /* when */                                           /* v2.30 */

    otherwise
    do
                        /* call the original FILESPEC function        */
      rc = "FILESPEC"( option, fileName )
    end /* otherwise */

  end /* select */

FileSpecError:

RETURN rc