/* SetLongNameEA - Set .LONGNAME EA - works for files only

    Copyright (c) 1998, 2005 Steven Levine and Associates, Inc.
    All rights reserved.

    $TLIB$: $ &(#) %n - Ver %v, %f $
    TLIB: $ $

    Revisions   01 Feb 1999 SHL Baseline
                17 Feb 2005 SHL Comments
                08 Apr 2005 JvW Removed prompt, no update WPS
                15 Mar 2014 JvW Short sleep before WM_CLOSE avoids timing issues
*/

/*
signal on Error
signal on FAILURE name Error
*/
signal on Halt
signal on NOTREADY name Error
signal on NOVALUE name Error
signal on SYNTAX name Error

call Initialize

Gbl.!Version = '0.1'

Main:

  /* Try for quoted long name */
  parse arg '"'fileName'"' title

  if length(fileName) = 0 then do
    /* Try FAT format */
    parse arg fileName title
  end

  title = strip(title, 'L')             /* Parse does not strip last arg */

  s = substr(fileName, 1, 1)
  if s == '-' | s == '/' then do
    s = translate(substr(fileName, 2))
    select
    when s = 'H' | s = '?' then
      call ScanArgsHelp
    otherwise
      call ScanArgsUsage
    end
  end

  if fileName == '' then
    call ScanArgsUsage 'File name required'

  err = SysFileTree(fileName, 'fileList', 'F')
  if err \= 0 then
    call Fatal 'SysFileTree failed'

  if fileList.0 > 1 then
    call Fatal 'Matched' fileList.0 'files'
  else if fileList.0 = 1 then do
    parse value fileList.1 with . . . . fullName
    fullName = strip(fullName)
  end
  else
    call Fatal fileName 'not found.'

  longNameEA = EARead(fileName, '.LONGNAME')
  shortNameEA = EARead(fileName, '.SHORTNAME')

  if longNameEA \= '' then do
    say fileName' has .LONGNAME:'
    say '  'longNameEA
    if shortNameEA \= '' then
      say '  and .SHORTNAME' shortNameEA
  end

  if title = '*' then do
    c = lastpos('\', fullName)
    title = substr(fullName, c + 1)     /*  Use file name for EA */
  end
  else if title == '' then do
      exit 1

  end /* if need title */

  c = lastpos('\', fullName)
  if c = 0 then
    shortName = fullName
  else
    shortName = substr(fullName, c + 1)

  rc = EAWrite(fullName, '.LONGNAME', title)

  if rc \= 0 then
    call Fatal 'SysPutEA .LONGNAME' fullName 'failed ('rc')'

  say fileName '.LONGNAME set to' title

  if shortName \= shortNameEA then do

    rc = EAWrite(fullName, '.SHORTNAME', shortName)

    if rc \= 0 then
      call Fatal 'SysPutEA .SHORTNAME' fullName 'failed ('rc')'

    say fileName '.SHORTNAME set to' shortName

  end

  say 'Opening' fullName 'to propagate title to Desktop.'
  call SysSetObjectData fullName, "OPEN=SETTINGS;"

  /* JvW WM_CLOSE often fails when not sleeping a short while! */
  Call SysSleep .1

  Parse Source with . myself .
  c = lastpos('\', myself)
  exedir = substr( myself, 1, c)
  address cmd exedir'sendmsg "'title'" WM_CLOSE'

  exit 0

/* end main */

/*=== AskTitle(fileName) ask title for file ===*/

AskTitle: procedure

  parse arg fileName

  call charout ,'Enter title for' fileName ': '

  title = linein()

  return title

/* end AskTitle */

/*=== Initialize() Intialize globals ===*/

Initialize: procedure expose Gbl.
  call GetCmdName
  call LoadRexxUtil
  return

/* end Initialize */

/*=== ReadInfTitle(fileName) return title from .inf file ===*/

ReadInfTitle: procedure

  parse arg fileName

  /* Scan and parse */

  call on NOTREADY name CatchError      /* Avoid death on missing NL */
  call stream fileName, 'C', 'OPEN READ'
  if RESULT \= 'READY:' then do
    say RESULT
    signal on NOTREADY name Error
    return ''
  end

  signal on NOTREADY name Error
  drop szCondition

  /* Verify header */
  buf = charin(fileName,,3)
  if buf \== 'HSP' then do
    call stream fileName, 'C', 'CLOSE'
    call Fatal 'Not a VIEW INF file'
  end

  /* Position to title string at 107 (0x6b) */

  call stream fileName, 'C', 'Seek 108' /* 1 relative */
  title = ''
  do 100
    drop buf
    call on NOTREADY name CatchError    /* Avoid death on missing NL */
    buf = charin(fileName,,1)
    signal on NOTREADY name Error
    if length(buf) \= 1 then do
      title = title || ' - unexpected EOF'
      leave                             /* Stop on EOF - should be more */
    end
    if buf == x2c('00') then
      leave                             /* Found end of string */
    title = title || buf
  end /* do */

  call stream fileName, 'C', 'CLOSE'

  return title

/* end ReadInfTitle */

/*=== ScanArgsHelp: Display help ===*/

ScanArgsHelp:
  say
  say 'Usage:' Gbl.!CmdName 'file [title]'
  say
  say 'Quote file name if not FAT format.  Do not quote title'
  say 'Use ^ to insert new line in title'
  say 'Use * to use filename as title'
  exit 255

/* end ScanArgsHelp */

/*=== ScanArgsUsage() ... ===*/

ScanArgsUsage:
  parse arg msg
  if msg \== '' then
    say msg
  say 'Usage:' Gbl.!CmdName 'file [title]'
  exit 255

/* end ScanArgsUsage */

/*========================================================================== */
/*=== SkelFunc standards - Delete unused - Move modified above this mark === */
/*========================================================================== */

/*=== EARead(fileName, eaName) Read EA; return EA value; build EARead. ===*/

EARead: procedure expose EARead.

  /*
     call EARead fileName, eaName
     EARead.
        !FileName       File name
        !EAName         EA name
        !nErr           Error code (0 = OK, -1 = not found, >0 = error)
        !xType          Type (in hex)
        !cLength        Text/data length
        !Text           Text/data
        !RawData        Raw EA
  */

  EARead.!FileName = arg(1)
  EARead.!EAName = arg(2)
  EARead.!Text = ''

  EARead.!nErr = SysGetEA(EARead.!FileName, EARead.!EAName, 'EARead.!RawData')

  if EARead.!nErr = 0 then do
    EARead.!cLength = length(EARead.!RawData)
    if EARead.!cLength = 0 then
      EARead.!nErr = -1
    else do
      EARead.!xType = c2x(substr(EARead.!RawData, 2, 1)substr(EARead.!RawData, 1, 1))
      EARead.!cLength = c2d(substr(EARead.!RawData, 4, 1)substr(EARead.!RawData, 3, 1))
      EARead.!Text = substr(EARead.!RawData, 5)
    end
  end

  return EARead.!Text                   /* 0 = OK */

/* end EARead */

/*=== EAWrite(fileName, eaName, text) Write text EA ===*/

EAWrite: procedure

  fileName = arg(1)
  eaName = arg(2)
  text = arg(3)

  type = 'FDFF'x                        /* text = xFFFD */

  c = length(text)
  len = d2c(c // 256)d2c(trunc(c / 256))        /* Intel format */

  eaRaw = type || len || text
  rc = SysPutEA(fileName, eaName, eaRaw)

  return rc                             /* OK if 0 */

/* end EAWrite */

/*========================================================================== */
/*=== SkelRexx standards - Delete unused - Move modified above this mark === */
/*========================================================================== */

/*=== Error() Report ERROR, FAILURE etc. and exit ===*/

Error:
  say
  parse source . . thisCmd
  say 'CONDITION'('C') 'signaled at line' SIGL 'of' thisCmd
  if 'CONDITION'('C') == 'SYNTAX' & 'SYMBOL'('RC') == 'VAR' then
    say 'REXX error' RC':' 'ERRORTEXT'(RC)
  say 'Source =' 'SOURCELINE'(SIGL)
  trace '?A'
  say 'Exiting'
  call 'SYSSLEEP' 2
  exit 'CONDITION'('C')

/* end Error */

/*=== Fatal(message) Report fatal error and exit ===*/

Fatal:
  parse arg msg
  say
  say Gbl.!CmdName':' msg
  call Beep 200, 300
  exit 254

/* end Fatal */

/*=== GetCmdName() Get script name; set Gbl.!CmdName ===*/

GetCmdName: procedure expose Gbl.
  parse source . . cmdName
  cmdName = filespec('N', cmdName)      /* Chop path */
  c = lastpos('.', cmdName)
  if c > 1 then
    cmdName = left(cmdName, c - 1)      /* Chop extension */
  Gbl.!CmdName = translate(cmdName, xrange('a', 'z'), xrange('A', 'Z')) /* Lowercase */
  return

/* end GetCmdName */

/*=== Halt() Report HALT condition and exit ===*/

Halt:
  say
  parse source . . thisCmd
  say 'CONDITION'('C') 'signaled at' SIGL 'of' thisCmd
  say 'Source = ' 'SOURCELINE'(SIGL)
  call 'SYSSLEEP' 2
  say 'Exiting'
  exit 'CONDITION'('C')

/* end Halt */

/*=== LoadRexxUtil() Load RexxUtil functions ===*/

LoadRexxUtil:
  if RxFuncQuery('SysLoadFuncs') then do
    call RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
    if RESULT then
      call Fatal 'Cannot load SysLoadFuncs'
    call SysLoadFuncs
  end
  return

/* end LoadRexxUtil */

/* The end */
