OS/2 Shareware BBS: 18 REXX/18-REXX.zip/instfont.zip/FixFont1.CMD

OS/2 REXX Batch file | 1999-04-20 | 20KB | 553 lines

/*------------------------------------------------------------------------*\
|                                                                          |
|           FIXFONT1.CMD - Version 1.0 - Version Date 1996-08-11           |
|                                                                          |
\*------------------------------------------------------------------------*/
/*

   Move all ?:\PSFONTS entries to M:\FONTS\PSFONTS or M:\FONTS\TRUETYPE
   and update OS2.INI file. FIXFONT2 will remove all unregistered fonts
   from \PSFONTS and FIXFONT3 will update all appropriate Windows INI files.

   The directory layout, and the files (by extension) within each are:

      ORIG-PS     .AFM .INF .PFB .PFM

      PSFONTS     .OFM .PFB
             \PFM .PFM

      ORIG-TTF    .TDF .TTF

      TRUETYPE    .TTF .FOT (path at '400'x)

   1) Check PM-Fonts in OS2.INI. If path contains a drive letter, move OFM
      file to M:\FONTS\PSFONTS and change INI file pointer. Move corresponding
      ?:\PSFONTS\*.PFB and ?:\PSFONTS\PFM\*.pfm file.

*/
GBL. = ''             /* initialize stem */
parse Arg             GBL.CommandLine
parse Version         GBL.RexxVersion,
                      GBL.RexxVersionLevel,
                      GBL.RexxVersionDay,
                      GBL.RexxVersionMonth,
                      GBL.RexxVersionYear    .
parse Source          GBL.OperatingSystem,
                      GBL.CallingEnvironment,
                      GBL.ProgramPathAndName   /* case is unreliable */

parse value DATE('S') with,
   year +4,
   mm   +2,
   dd

GBL.List            = 'GBL.'
GBL.Environment     = 'OS2ENVIRONMENT'
GBL.BootDrive       = LEFT( VALUE( 'RUNWORKPLACE',, GBL.Environment ), 2 )
GBL.CurrentDate     = mm || '/' || dd || '/' || year
GBL.Hostname        = VALUE( 'MACHINENAME',, GBL.Environment )
GBL.Ramdrive        = VALUE( 'RAMDRIVE',, GBL.Environment )
GBL.ProgramVersion  = 1.0           /* version / mod of this program */
GBL.ProgramName     = STRIP( FILESPEC( 'N', GBL.ProgramPathAndName ) )
GBL.ProgramPath     = STRIP( FILESPEC( 'D', GBL.ProgramPathAndName ) ||,
                             FILESPEC( 'P', GBL.ProgramPathAndName ) )

parse var GBL.ProgramName,
   GBL.ProgramFn  '.',
   GBL.ProgramFe
GBL.ProgramFe  = TRANSLATE( GBL.ProgramFe  )
call TIME 'R'                    /* reset elapsed timer - sssss.uuuuu */
say 'Begin' GBL.ProgramFn || '.' || GBL.ProgramFe  'at' TIME('N')

/*------------------------*\
|  Enable trap processing  |
|    if REXXLIB present    |
\*------------------------*/
   SIGNAL ON ERROR
   SIGNAL ON FAILURE
   SIGNAL ON HALT
   SIGNAL ON NOVALUE
   SIGNAL ON SYNTAX

crlf           = '0D0A'x
font_home_path = 'M:\FONTS\'

GBL.LogFile  =,
   GBL.ProgramPath  ||,
   GBL.ProgramFn    || '.LOG'
if STREAM( GBL.LogFile, 'C', 'QUERY EXISTS' ) ¬= '' then
   do
      log_line = crlf || COPIES( '=', 76 )
      call LINEOUT GBL.LogFile, log_line
   end
log_line = GBL.ProgramFn || '.' || GBL.ProgramFe || ' Started on' DATE() 'at' TIME() ' CPU:' GBL.Hostname '-' GBL.OperatingSystem
call LINEOUT GBL.LogFile, log_line

/*--------------------------------------*\
|  Create stem with all PM_Font entries  |
\*--------------------------------------*/
app_name = 'PM_Fonts'
call SysIni 'USER', app_name, 'ALL:', 'font_stem'
if RESULT = 'ERROR:' then
   do
      log_line =,
         'Unable to locate' app_name 'in' VALUE( 'USER_INI',, GBL.Environment )
      call LINEOUT GBL.LogFile, log_line
      say log_line
      call EOJ
   end

/*------------------------------------*\
|  Move each font with a drive letter  |
|     in its path to the home path     |
\*------------------------------------*/
do f = 1 to font_stem.0
   font_name = font_stem.f
   font_path_and_name =,
      TRANSLATE( STRIP( SysIni( 'USER', app_name, font_name ), 'T', '00'x ) )
   if font_path_and_name = 'ERROR:' then
      do
         say '   Error retrieving path for' font_name 'from' VALUE( 'USER_INI',, GBL.Environment )
         iterate f
      end

   ini_font_drive = FILESPEC( 'D', font_path_and_name )
   ini_font_path  = FILESPEC( 'P', font_path_and_name )
   ini_font_name  = FILESPEC( 'N', font_path_and_name )
   parse value ini_font_name with,
      ini_font_fn '.' ini_font_fe

   /* Ignore OS/2 default fonts */
   if ini_font_drive = '' then iterate f
   if RIGHT( font_path_and_name, 4 ) = '.FON' then iterate f

   /* Ignore fonts that are in correct directory */
   if LEFT( font_path_and_name, LENGTH(font_home_path) ) = font_home_path then iterate f

   /* Setup correct sub-directory */
   if ini_font_fe = 'TTF' then
      do
         font_path = font_home_path || 'TRUETYPE\'
         orig_path = font_home_path || 'ORIG-TTF\'
      end
   else
      do
         font_path = font_home_path || 'PSFONTS\'
         orig_path = font_home_path || 'ORIG-PS\'
      end

   /*----------------------------------------*\
   |  Copy font from boot drive to home area  |
   \*----------------------------------------*/
   call SysFileTree ini_font_drive || ini_font_path || ini_font_fn ||'.*',,
                    'old_stem', 'FST'
   do i = 1 to old_stem.0
      parse upper value old_stem.i with,
         old_timestamp,
         old_size,
         old_attr,
         old_path_and_file_name
      old_path_and_file_name = STRIP( old_path_and_file_name )

      parse value FILESPEC( 'N', old_path_and_file_name ) with,
         old_fn '.' old_fe
      select
         when old_fe = 'AFM' then
            do
               call STOW_FONT_FILE old_path_and_file_name, orig_path || old_fn'.'old_fe, 'R'
               if RESULT = 0 then
                  do
                     call SysFileDelete old_path_and_file_name
                  end
            end
         when old_fe = 'OFM' then
            do
               call STOW_FONT_FILE old_path_and_file_name, font_path || old_fn'.'old_fe, 'R'
               if RESULT = 0 then
                  do
                     call SysFileDelete old_path_and_file_name
                  end
            end
         when old_fe = 'PFB' then
            do
               call STOW_FONT_FILE old_path_and_file_name, orig_path || old_fn'.'old_fe, 'R'
               call STOW_FONT_FILE old_path_and_file_name, font_path || old_fn'.'old_fe, 'R'
               if RESULT = 0 then
                  do
                     call SysFileDelete old_path_and_file_name
                  end
            end
         when old_fe = 'PFM' then
            do
               call STOW_FONT_FILE old_path_and_file_name, orig_path || old_fn'.'old_fe, 'R'
               call STOW_FONT_FILE old_path_and_file_name, font_path || 'PFM\' || old_fn'.'old_fe, 'R'
               if RESULT = 0 then
                  do
                     call SysFileDelete old_path_and_file_name
                  end
            end
         when old_fe = 'FOT' then
            do
               call STOW_FONT_FILE old_path_and_file_name, font_path || old_fn'.'old_fe, 'R'
               /* FixFont3 will delete the original */
            end
         when old_fe = 'TTF' then
            do
               call STOW_FONT_FILE old_path_and_file_name, orig_path || old_fn'.'old_fe, 'R'
               call STOW_FONT_FILE old_path_and_file_name, font_path || old_fn'.'old_fe, 'R'
               /* FixFont3 will delete the original */
            end
         otherwise
            do
               say COPIES( ' ', 3 ) || old_path_and_file_name 'contains an unknown file extension and is ignored'
               iterate i
            end
      end
   end

!tr! = VALUE('TRACE',,GBL.Environment); if !tr! <> '' then do;say 'Trace' !tr! 'started';TRACE(!tr!);nop;end
   /*-----------------------*\
   |  Update INI file entry  |
   \*-----------------------*/
   key_value =,
      font_path || old_fn'.'old_fe
   call SysIni 'USER', app_name, font_name, key_value || '00'x
   if RESULT = 'ERROR:' then
      do
         log_line =,
            'Error updating' VALUE( 'USER_INI',, GBL.Environment )':',
            ' App =' app_name';',
            ' Key =' font_name';',
            ' Key value =' key_value
         call LINEOUT GBL.LogFile, log_line
         call logic_error
      end

end

call EOJ 0

/*------------------------------------------------------------------------*\
|                                                                          |
|                 Copy / replace font file as appropriate                  |
|                                                                          |
\*------------------------------------------------------------------------*/
STOW_FONT_FILE:
   Procedure expose,
      (GBL.List)

parse ARG source_path_and_file_name, object_path_and_file_name

parse value STREAM( source_path_and_file_name, 'C', 'QUERY DATETIME' ) with,
   source_month '-',
   source_day   '-',
   source_yy    ' ',
   source_time
if source_yy < 80 then source_year = '20' || source_yy
else                   source_year = '19' || source_yy
source_timestamp =,
   source_year ||,
   RIGHT( source_month, 2, '0' ) ||,
   RIGHT( source_day,   2, '0' ) ||,
   source_time

if STREAM( object_path_and_file_name, 'C', 'QUERY EXISTS' ) ¬= '' then
   do
      parse value STREAM( object_path_and_file_name, 'C', 'QUERY DATETIME' ) with,
         object_month '-',
         object_day   '-',
         object_yy    ' ',
         object_time
      if object_yy < 80 then object_year = '20' || object_yy
      else                   object_year = '19' || object_yy
      object_timestamp =,
         object_year ||,
         RIGHT( object_month, 2, '0' ) ||,
         RIGHT( object_day,   2, '0' ) ||,
         object_time

      if source_timestamp <= object_timestamp then
         do
            return 0
         end
   end

/*-------------------------------------------*\
|  FOT files must have internal path updated  |
|         others are simply copied            |
\*-------------------------------------------*/
log_line =,
   LEFT( FILESPEC( 'N', source_path_and_file_name ), 13 )

parse upper value FILESPEC( 'N', source_path_and_file_name ) with,
   source_fn '.' source_fe

if source_fe ¬= 'FOT' then
   do
      copy_rc = DOSCOPY( source_path_and_file_name, object_path_and_file_name, 'R' )
      if copy_rc = 0 then
         do
            log_line = log_line ||,
               'was copied to'
         end
      else
         do
            log_line = log_line ||,
               'could not be copied to'
         end
   end
else
   do
      fot_size = STREAM( source_path_and_file_name, 'C', 'QUERY SIZE' )
      fot_area = CHARIN( source_path_and_file_name, 1, fot_size )
      call STREAM source_path_and_file_name, 'C', 'CLOSE'

      ttf_path_and_file_name =,
         FILESPEC( 'D', object_path_and_file_name ) ||,
         FILESPEC( 'P', object_path_and_file_name ) ||,
         source_fn || '.TTF'
      fot_path_ptr  = X2D( 400 ) + 1
      fot_path_lgth = 96
      fot_area =,
         OVERLAY( COPIES( '00'x, fot_path_lgth ), fot_area, fot_path_ptr )
      fot_area =,
         OVERLAY( ttf_path_and_file_name, fot_area, fot_path_ptr )
      call SysFileDelete object_path_and_file_name
      call CHAROUT object_path_and_file_name, fot_area
      call STREAM object_path_and_file_name, 'C', 'CLOSE'
      log_line = log_line ||,
         'was updated and copied to'
      copy_rc = 0
   end

log_line = log_line,
   FILESPEC( 'D', object_path_and_file_name ) ||,
   FILESPEC( 'P', object_path_and_file_name ),
   'from',
   FILESPEC( 'D', source_path_and_file_name ) ||,
   FILESPEC( 'P', source_path_and_file_name )
call LINEOUT GBL.LogFile, log_line

return copy_rc


/*------------------------------------------------------------------------*\
|                                                                          |
|                                End of Job                                |
|                                                                          |
\*------------------------------------------------------------------------*/
EOJ:
   Procedure expose,
      GBL.

call STREAM GBL.LogFile, 'C', 'CLOSE'

if ARG() = 0 then
   eoj_rc = 0
else
   eoj_rc = ARG(1)

elapsed_time = TIME('E')            /* get elapsed time - sssss.uuuuu */
parse value elapsed_time with seconds '.' micro_seconds
if LEFT( micro_seconds, 1, 1 ) >= 5 then
   seconds = seconds + 1
ss = FORMAT( seconds // 60, 2 )
minutes = ( seconds - ss ) / 60
mm = FORMAT( minutes // 60, 2 )
hh = FORMAT( ( minutes - mm ) / 60, 2 )
duration = hh':'mm':'ss

say 'EOJ   ' || GBL.ProgramFn || '.' || GBL.ProgramFe 'at' TIME('N') ||,
    ', duration' TRANSLATE( duration, '0', ' ' )
exit eoj_rc

/*------------------------------------------------------------------------*\
|                                                                          |
|                              Trap Routines                               |
|                                                                          |
\*------------------------------------------------------------------------*/
ERROR:       call TRAP_PROCESSING_01   SIGL, 'ERROR',   RC
FAILURE:     call TRAP_PROCESSING_01   SIGL, 'FAILURE', RC
HALT:        call TRAP_PROCESSING_01   SIGL, 'HALT',    ''
LOGIC_ERROR: call TRAP_PROCESSING_01   SIGL, 'LOGIC',   ARG( 1 )
NOVALUE:     call TRAP_PROCESSING_01   SIGL, 'NOVALUE', ''
SYNTAX:      call TRAP_PROCESSING_01   SIGL, 'SYNTAX',  RC

TRAP_PROCESSING_01:
   SIGNAL ON ERROR   name TRAP_PROCESSING_02 /* prevent recursion */
   SIGNAL ON FAILURE name TRAP_PROCESSING_02 /* prevent recursion */
   SIGNAL ON HALT    name TRAP_PROCESSING_02 /* prevent recursion */
   SIGNAL ON NOVALUE name TRAP_PROCESSING_02 /* prevent recursion */
   SIGNAL ON SYNTAX  name TRAP_PROCESSING_02 /* prevent recursion */
   ?Trap.   = ''     /* Revised 98/12/18 */
   TRAP_DMP = ''     /* .DMP path & file name */
   TRAP_DMP_TIMESTAMP = DATE( ) || COPIES(' ', 2 ) || LEFT( TIME('L'),11 )

/*---------------------*\
|  Program path & name  |
\*---------------------*/
parse Source  ?Trap.?OperatingSystem . ?Trap.?ProgramPathAndFileName
parse Version ?Trap.?RexxVersion

?Trap.?LineNumber = ARG( 1 )
if POS( ':', ?Trap.?ProgramPathAndFileName ) > 0 then
   /* get source line if it is available */
   do ?T = 1
      TRAP_SOURCE_LINE.?T =  SOURCELINE( ?Trap.?LineNumber )
      TRAP_SOURCE_LINE.0  = ?T
      if TRAP_SOURCE_LINE.?T == '' then
         do
            TRAP_SOURCE_LINE.?T = 'Source is not available'
            leave
         end
      ?Trap.?LineNumber   = ?Trap.?LineNumber + 1
      if RIGHT( TRAP_SOURCE_LINE.?T, 1 ) ¬== ',' then
         do
            leave
         end
   end
else
   /* program is running in macrospace */
   do
      ?Trap.?ProgramPathAndFileName =,
         STRIP( DIRECTORY( ), 'T', '\' ) || '\' ||,
         ?Trap.?ProgramPathAndFileName
      TRAP_SOURCE_LINE.1 = 'Source line is not available.'
      TRAP_SOURCE_LINE.0 = 1
   end

parse value FILESPEC( 'N', ?Trap.?ProgramPathAndFileName ) with,
   ?Trap.?Fn '.' ?Trap.?Fe
TRAP_DMP =,
   FILESPEC( 'D', ?Trap.?ProgramPathAndFileName ) ||,
   FILESPEC( 'P', ?Trap.?ProgramPathAndFileName ) ||,
   ?Trap.?Fn || '.' || 'DMP'

/*-------------------------------------------*\
|  Determine whether ANSII or VX-REXX output  |
\*-------------------------------------------*/
?Trap.?VXREXX = ( RxFuncQuery( 'VRWindow' ) = 0 )
if ?Trap.?VXREXX then
   do
      /* see if Primary Window handle exists */
      ?Trap.?VXREXX = ( LEFT( VRWindow( ), 1 ) = '?' )
   end

/*------------------------------------------*\
|  Check for reason NOT to create .DMP file  |
\*------------------------------------------*/
select
   when ARG( 2 ) = 'HALT' then
      do
         TRAP_DMP = ''
      end
   when POS( ':', TRAP_DMP ) = 0 then
      do
         TRAP_DMP = ''
      end
   when ABBREV( ?Trap.?RexxVersion, 'OBJREXX' ) then
      do
         if RxFuncQuery( 'SysDumpVariables' ) <> 0 then
            do
               TRAP_DMP = ''
            end
      end
   when ?Trap.?OperatingSystem = 'OS/2' then
      do
         if RxFuncQuery( 'VARDUMP' ) <> 0 then
            do
               TRAP_DMP = ''
            end
      end
   otherwise
      do
         nop
      end
end

/*------------------------*\
|  Build trap message box  |
\*------------------------*/
?DBL.H     = 'CD'x                 /* ═ double line - horizontal   */
?DBL.V     = 'BA'x                 /* ║ double line - vertical     */
?DBL.BL    = 'C8'x                 /* ╚ double line - bottom left  */
?DBL.BR    = 'BC'x                 /* ╝ double line - bottom right */
?DBL.TL    = 'C9'x                 /* ╔ double line - top left     */
?DBL.TR    = 'BB'x                 /* ╗ double line - top right    */
if ?Trap.?OperatingSystem ¬== 'WindowsNT' then
   do
      ?Trap.?RED = '1B'x || '[1;37;41m'  /* bright white on red    */
      ?Trap.?DUL = '1B'x || '[0m'        /* reset to normal        */
   end
?Trap.?Margin = COPIES( ' ', 2 )

TRAP_ERROR_DESCRIPTION =,
   'Error line = ' || ARG( 1 ) || '; ' || ARG( 2 ) || ' trap caught'
if ARG( 3 ) <> '' then
   TRAP_ERROR_DESCRIPTION = TRAP_ERROR_DESCRIPTION ||,
      '  Return code = ' || ARG( 3 )

?T=0
?T=?T+1; ?Trap.?line.?T = ?Trap.?Fn'.'?Trap.?Fe
?T=?T+1; ?Trap.?line.?T = TRAP_ERROR_DESCRIPTION
if TRAP_DMP <> '' then
   do
?T=?T+1; ?Trap.?line.?T = ''
?T=?T+1; ?Trap.?line.?T = 'See: ' || TRAP_DMP
   end
?T=?T+1; ?Trap.?line.?T = ''
?T=?T+1; ?Trap.?line.?T = 'Source line(s) at time of trap:'
do ?S = 1 to TRAP_SOURCE_LINE.0
   ?T=?T+1; ?Trap.?line.?T = ?Trap.?Margin || TRAP_SOURCE_LINE.?S
end
         ?Trap.?line.0 = ?T
if ?Trap.?VXREXX then
   do
      ?Trap.?PrimaryWindowHandle = VRWindow( )
      call VRSet  ?Trap.?PrimaryWindowHandle,,
                  'BackColor',      'White',,
                  'ForeColor',      'Red',,
                  ''

      call VRMessageStem ?Trap.?PrimaryWindowHandle,,
                         '?Trap.?line.',,
                         CENTER( ?Trap.?Fn 'Fatal error', 74 ),,
                         'E'
   end
else
   do
      ?Trap.?Width = MAX( 74, LENGTH( TRAP_ERROR_DESCRIPTION ) )
      say ?Trap.?RED || ?DBL.TL || COPIES( ?DBL.H,?Trap.?Width + 2 ) || ?DBL.TR || ?Trap.?DUL
      say ?Trap.?RED || ?DBL.V  || COPIES( ' ',   ?Trap.?Width + 2 ) || ?DBL.V  || ?Trap.?DUL
      do ?T = 1 to ?Trap.?line.0
      say ?Trap.?RED || ?DBL.V    LEFT( ?Trap.?line.?T, ?Trap.?Width )   ?DBL.V  || ?Trap.?DUL
      end
      say ?Trap.?RED || ?DBL.V  || COPIES( ' ',   ?Trap.?Width + 2 ) || ?DBL.V  || ?Trap.?DUL
      say ?Trap.?RED || ?DBL.BL || COPIES( ?DBL.H,?Trap.?Width + 2 ) || ?DBL.BR || ?Trap.?DUL
   end

/*---------------------------------*\
|  Create .DMP file if appropriate  |
\*---------------------------------*/
if TRAP_DMP <> '' then
   do
      /* remove meaningless labels from dump for clarity */
      drop ( GBL.DumpExclusionList )
      drop ?dbl. ?Trap. ?S ?T ?tr?
      call SysFileDelete TRAP_DMP
      select
         when RxFuncQuery( 'VARDUMP' ) == 0 then
            do
               call VARDUMP TRAP_DMP  /* write variables to program.DMP file */
            end
         when RxFuncQuery( 'SysDumpVariables' ) == 0 then
            do
               call SysDumpVariables TRAP_DMP  /* write variables to program.DMP file */
            end
         otherwise; nop
      end
   end

TRAP_PROCESSING_02:
   exit 255