home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / wps / editor / epmtools / epmsmp / ea.e < prev    next >
Encoding:
Text File  |  1992-10-16  |  28.1 KB  |  640 lines
  1. ; Routines for manipulating extended attributes.
  2. ;
  3. ; EPM's .eaarea field contains a pointer to a buffer containing the
  4. ; extended attributes for the current file.  This is an FEALIST; see
  5. ; the OS/2 Tech Ref for details.  If the file was loaded from disk,
  6. ; the .eaarea will *always* contain a pointer to an FEALIST.  If the
  7. ; file had no extended attributes, this FEALIST will contain nothing
  8. ; but a length field indicating an FEALIST length of 4.
  9. ;
  10. ; A newly created file in the editor will contain a .eaarea of 0 - i.e.
  11. ; a null pointer, indicating that the FEALIST does not exist.
  12. ;
  13. ; Don't forget - changing the .eaarea field or adding extended attributes
  14. ; does not affect the .modify field.  If you want to ensure that the
  15. ; attributes are saved, you may want to explicitly increment .modify in
  16. ; your routines.
  17. ;
  18. ; by Larry Margolis
  19.  
  20. ; Note:  This file contains some duplicated and redundant functions; it's a
  21. ; toolkit of routines for playing with extended attributes.  Extract what you
  22. ; need for your application.  The "Dependencies" comment before each routine
  23. ; tells what other pieces you need from this file.  Dependencies on routines
  24. ; from the base set of macros (e.g., entrybox(), winmessagebox() ) are not
  25. ; mentioned.  Note that some of these routines are included in EPM_EA which
  26. ; is part of the base set of macros.
  27. ;
  28. ; Index:
  29. ; QEA             Tells what the .eaarea is set to
  30. ; SHOW_EA         Displays all extended attributes
  31. ; GET_EA          Tells you the value for a given attribute name
  32. ; get_ea_value()  Returns the value for a given attribute name
  33. ; get_ea_value2() As above, but uses find_ea() & only handles EAT_ASCII
  34. ; find_ea()       Looks for a given attribute; sets lots of VAR parameters
  35. ; SET_EA          Sets a single name / value pair in an empty .eaarea
  36. ; SET_EA_MANY     Sets a number of name / value pairs in an empty .eaarea
  37. ; ADD_EA          Adds a single name / value pair to an existing EA list
  38. ; GET_EA2         Like GET_EA, but uses find_ea() instead of get_ea_value()
  39. ; DELETE_EA       Deletes a named extended attribute
  40. ; delete_ea()     Deletes a named extended attribute
  41. ; TYPE            Displays and optionally sets the .TYPE extended attribute
  42. ; SETFILETYPE     Sets the .TYPE extended attribute to anything
  43. ; SUBJECT         Displays and optionally sets the .SUBJECT extended attribute
  44. ; PUTFIELD        Store a field (.filename, .userstring, etc.) in an EA.
  45. ; GETFIELD        Set a field from the value previously saved in the EA.
  46.  
  47. const                      -- Some constants
  48.    EAT_BINARY   = \254\255    -- FFFE
  49.    EAT_ASCII    = \253\255    -- FFFD
  50.    EAT_BITMAP   = \251\255    -- FFFB
  51.    EAT_METAFILE = \250\255    -- FFFA
  52.    EAT_ICON     = \249\255    -- FFF9
  53.    EAT_EA       = \238\255    -- FFEE
  54.    EAT_MVMT     = \223\255    -- FFDF
  55.    EAT_MVST     = \222\255    -- FFDE
  56.    EAT_ASN1     = \221\255    -- FFDD
  57.  
  58.                                 -- Just see what the .eaarea is set to.
  59. ; Dependencies:  None
  60. defc qea = sayerror '.eaarea = '.eaarea '= x'ltoa(atol(.eaarea),16)
  61.  
  62. ; Dependencies:  None
  63. defc showea, show_ea =                   -- Show all extended attributes
  64.    if abbrev('FILE', upcase(arg(1)), 1) then  -- 'ShowEA F' to dump to a file
  65.       file_flag = 1
  66.       'xcom e /n'
  67.       if rc<>-282 then sayerror 'Could not open output file!'; return rc; endif
  68.       getfileid fid
  69.       .autosave = 0
  70.       prevfile
  71.       fid.titletext = '.eaarea of "'.filename'"'
  72.    else
  73.       file_flag = 0
  74.       fid = ''
  75.    endif
  76. ;  ea_seg = .eaarea % 65536
  77. ;  ea_ofs = .eaarea // 65536
  78.    ea_long = atol(.eaarea)
  79.    ea_seg = itoa(rightstr(ea_long,2),10)
  80.    ea_ofs = itoa(leftstr(ea_long,2),10)
  81.    if .eaarea then
  82.       ea_len  = ltoa(peek(ea_seg, ea_ofs, 4),10)
  83. ;     insertline peek(ea_seg, ea_ofs, min(ea_len,255)), .last+1
  84.    else
  85.       ea_len = 0
  86.    endif
  87.    ea_output(file_flag, '.eaarea = '.eaarea '= x'ltoa(ea_long,16)'; ea_seg =' ea_seg '= x'itoa(atoi(ea_seg),16)'; ea_ofs =' ea_ofs'; ea_len = 'ea_len, fid)
  88.    ea_count = 0
  89.    ea_end = ea_ofs + ea_len
  90.    ea_ofs = ea_ofs + 4        -- Point past length of FEAList
  91.    do while ea_ofs < ea_len
  92.       ea_flag = itoa(peek(ea_seg, ea_ofs, 1)\0,16)
  93.       ea_namelen  = asc(peek(ea_seg, ea_ofs+1, 1))
  94.       ea_valuelen = ltoa(peek(ea_seg, ea_ofs+2, 2)\0\0,10)
  95.       ea_name  = peekz(ea_seg, ea_ofs+4)
  96.       if ea_valuelen then
  97.          ea_value = peek(ea_seg, ea_ofs+5+ea_namelen,min(ea_valuelen,255))
  98.          ea_datatype = rightstr(itoa(leftstr(ea_value,2),16),4,0)
  99.          ea_datalen = itoa(substr(ea_value,3,2),10)
  100.          ea_data = substr(ea_value,5)
  101.       else
  102.          ea_value = ''
  103.          ea_datatype = '????'
  104.          ea_datalen = 0
  105.          ea_data = ''
  106.       endif
  107.       ea_count = ea_count + 1
  108.       if leftstr(ea_value,2) = EAT_MVMT then
  109.          ea_output(file_flag, 'EA' ea_count 'flag=x'ea_flag 'name('ea_namelen')="'ea_name'"; type=x'ea_datatype' (MVMT); value('ea_valuelen') =', fid)
  110.          ea_codepage   = ea_datalen
  111.          ea_numentries = itoa(leftstr(ea_data,2),10)
  112.          if ea_numentries=1 then
  113.             ea_entrylen = itoa(substr(ea_data,5,2),10)
  114.             ea_output(file_flag, 'CP' ea_codepage '1 entry:  type=x'rightstr(itoa(substr(ea_data,3,2),16),4,0)'; len='ea_entrylen'; "'substr(ea_data,7,ea_entrylen)'"', fid)
  115.          else
  116.             ea_entry_ofs = ea_ofs+11+ea_namelen
  117.             ea_output(file_flag, 'CP' ea_codepage';' ea_numentries 'entries: (ofs='ea_entry_ofs')', fid)
  118.             do i=1 to ea_numentries
  119.                ea_entrylen = itoa(peek(ea_seg, ea_entry_ofs+2, 2),10)
  120. ;         messageNwait( '  >> peeking at' ea_entry_ofs', entry' i 'type=x'rightstr(itoa(peek(ea_seg,ea_entry_ofs,2),16),4,0))
  121.                ea_entry = peek(ea_seg, ea_entry_ofs,min(ea_entrylen+4,255))
  122.                ea_output(file_flag, '  entry' i 'type=x'rightstr(itoa(leftstr(ea_entry,2),16),4,0)'; len='ea_entrylen'; "'substr(ea_entry,5)'"', fid)
  123.                ea_entry_ofs = ea_entry_ofs + ea_entrylen + 4
  124.             enddo
  125.          endif
  126.       elseif leftstr(ea_value,2) = EAT_MVST then
  127.          ea_output(file_flag, 'EA' ea_count 'flag=x'ea_flag 'name('ea_namelen')="'ea_name'"; type=x'ea_datatype' (MVST); value('ea_valuelen') =', fid)
  128.          ea_codepage   = ea_datalen
  129.          ea_numentries = itoa(leftstr(ea_data,2),10)
  130.          if ea_numentries=1 then
  131.             ea_entrylen = itoa(substr(ea_data,5,2),10)
  132.             ea_output(file_flag, 'CP' ea_codepage'; type=x'rightstr(itoa(substr(ea_data,3,2),16),4,0) '1 entry:  len='ea_entrylen'; "'substr(ea_data,7,ea_entrylen)'"', fid)
  133.          else
  134.             ea_entry_ofs = ea_ofs+13+ea_namelen
  135.             ea_output(file_flag, 'CP' ea_codepage'; type=x'rightstr(itoa(substr(ea_data,3,2),16),4,0) ea_numentries 'entries: (ofs='ea_entry_ofs')', fid)
  136.             do i=1 to ea_numentries
  137.                ea_entrylen = itoa(peek(ea_seg, ea_entry_ofs, 2),10)
  138. ;         messageNwait( '  >> peeking at' ea_entry_ofs', entry' i
  139.                ea_entry = peek(ea_seg, ea_entry_ofs,min(ea_entrylen+2,255))
  140.                ea_output(file_flag, '  entry' i 'len='ea_entrylen'; "'substr(ea_entry,3)'"', fid)
  141.                ea_entry_ofs = ea_entry_ofs + ea_entrylen + 2
  142.             enddo
  143.          endif
  144.       else
  145.          ea_output(file_flag, 'EA' ea_count 'flag=x'ea_flag 'name('ea_namelen')="'ea_name'"; type=x'ea_datatype'; value('ea_valuelen','ea_datalen') =', fid)
  146.          ea_output(file_flag, '"'ea_data'"', fid)
  147.       endif
  148.       ea_ofs = ea_ofs + ea_namelen + 5 + ea_valuelen      -- Point past length of FEAList
  149.    enddo
  150.    if file_flag then
  151.       fid.modify = 0
  152.       nextfile
  153.    endif
  154.  
  155. defproc ea_output(file_flag, outstr, fid)
  156.    if file_flag then
  157.       insertline outstr, fid.last+1, fid
  158.    else
  159.       sayerror outstr
  160.    endif
  161.  
  162. ; Dependencies:  get_ea_value()
  163. defc getea, get_ea =                 -- Tells you the value for a given attribute name
  164.    parse arg name .
  165.    if name='' then
  166.       sayerror 'GET_EA <name> tells you the extended attribute value for the given attribute name.'
  167.       return
  168.    endif
  169.    val = get_ea_value(name)
  170.    if leftstr(val,2)=\253\255 then      -- x'FFFD', after byte reversal
  171.       stuff = 'EAT_ASCII ('itoa(substr(val,3,2),10)') '
  172.       val = substr(val,5)
  173.    else
  174.       stuff = ''
  175.    endif
  176.    sayerror name'='stuff'"'val'"'
  177.  
  178. ; Dependencies:  None
  179. defproc get_ea_value(name) =  -- Returns the value for a given attribute name
  180. ;  ea_seg = .eaarea % 65536
  181. ;  ea_ofs = .eaarea // 65536
  182.    ea_long = atol(.eaarea)
  183.    ea_seg = itoa(rightstr(ea_long,2),10)
  184.    ea_ofs = itoa(leftstr(ea_long,2),10)
  185.    if not .eaarea then return ''; endif
  186.    ea_len  = ltoa(peek(ea_seg, ea_ofs, 4),10)
  187.    ea_end = ea_ofs + ea_len
  188.    ea_ofs = ea_ofs + 4        -- Point past length of FEAList
  189.    do while ea_ofs < ea_len
  190. ;;    ea_flag = itoa(peek(ea_seg, ea_ofs, 1)\0,16)
  191.       ea_namelen  = asc(peek(ea_seg, ea_ofs+1, 1))
  192.       ea_valuelen = itoa(peek(ea_seg, ea_ofs+2, 2),10)
  193.       if name = peekz(ea_seg, ea_ofs+4) then
  194.          if ea_valuelen then
  195.             return peek(ea_seg, ea_ofs+5+ea_namelen,min(ea_valuelen,255))
  196.          else
  197.             leave            -- value length = 0; return null string
  198.          endif
  199.       endif
  200.       ea_ofs = ea_ofs + ea_namelen + 5 + ea_valuelen      -- Point past length of FEAList
  201.    enddo
  202.  
  203. ; Dependencies:  find_ea
  204. defproc get_ea_value2(name) =  -- Returns the value for a given (EAT_ASCII) attribute name
  205.    if find_ea(name, ea_seg, ea_ofs, ea_ptr1, ea_ptr2, ea_len, ea_entrylen, ea_valuelen) then
  206.       return peek(ea_seg, ea_ptr2, min(ea_valuelen,255))
  207.    endif
  208.  
  209. ;  Returns 1 if attribute name exists; sets VAR args.  EA_SEG, EA_OFS =
  210. ; start of EA buffer.  EA_PTR1, 2 = pointers to start of entry and value,
  211. ; respectively, if name was found.  EA_LEN, EA_ENTRYLEN, EA_VALUELEN = length
  212. ; of EA area, of entry, and of value, respectively.
  213. ; Dependencies:  None
  214. defproc find_ea(name, var ea_seg, var ea_ofs, var ea_ptr1, var ea_ptr2, var ea_len, var ea_entrylen, var ea_valuelen) =
  215.    ea_long = atol(.eaarea)
  216.    ea_seg = itoa(rightstr(ea_long,2),10)
  217.    ea_ofs = itoa(leftstr(ea_long,2),10)
  218.    if not .eaarea then return ''; endif
  219.    ea_len  = ltoa(peek(ea_seg, ea_ofs, 4),10)
  220.    ea_end = ea_ofs + ea_len
  221.    ea_ptr1 = ea_ofs + 4                     -- Point past length of FEAList
  222.    do while ea_ptr1 < ea_len
  223. ;     ea_flag = itoa(peek(ea_seg, ea_ptr1, 1)\0,16)
  224.       ea_namelen  = asc(peek(ea_seg, ea_ptr1+1, 1))
  225.       ea_valuelen = itoa(peek(ea_seg, ea_ptr1+2, 2),10)
  226.       ea_entrylen = ea_namelen + 5 + ea_valuelen
  227.       if name = peekz(ea_seg, ea_ptr1+4) then
  228.          ea_ptr2 = ea_ptr1+5+ea_namelen  -- Point to start of EA value
  229.          return 1
  230.       endif
  231.       ea_ptr1 = ea_ptr1 + ea_entrylen       -- Point to start of next entry
  232.    enddo
  233.  
  234. ; Dependencies:  None
  235. defc setea, set_ea =                 -- Sets a single name / value pair
  236.    parse arg name data
  237.    if name='' then
  238.       sayerror 'SET_EA <name> <value> sets the extended attribute value for a new file *only*.'
  239.       return
  240.    endif
  241.    name_len = length(name)
  242.    data_len = length(data)
  243.    ea_len = 13 + name_len + data_len
  244.    if .eaarea then
  245.       ea_long = atol(.eaarea)
  246.       ea_seg = itoa(rightstr(ea_long,2),10)
  247.       ea_ofs = itoa(leftstr(ea_long,2),10)
  248.       ea_old_len  = ltoa(peek(ea_seg, ea_ofs, 4),10)
  249.       if ea_old_len > 4 then
  250.          sayerror '.eaarea already set; this example is only for newly-created edit files.'
  251.          return
  252.       endif
  253.       r =  dynalink('DOSCALLS',           -- Dynamic link library name
  254.                '#38',                     -- DosReAllocSeg
  255.                atoi(ea_len)           ||  -- Number of bytes requested
  256.                rightstr(ea_long,2) )
  257.       re = 're'
  258.       ea_ptr = ea_seg
  259.    else
  260.       ea_buffer = "00"                    -- Initialize string pointer.
  261.       r =  dynalink('DOSCALLS',           -- Dynamic link library name
  262.                '#34',                     -- DosAllocSeg
  263.                atoi(ea_len)           ||  -- Number of bytes requested
  264.                selector(ea_buffer)    ||  -- String selector
  265.                offset(ea_buffer)      ||  -- String offset
  266.                atoi(0) )                  -- Share information
  267.       re = ''
  268.       ea_ptr = itoa(ea_buffer,10)
  269.    endif
  270.  
  271.    if r then sayerror 'Error' r re'allocating memory segment; command halted.'; stop; endif
  272.    poke ea_ptr, 0, atol(ea_len)
  273.    poke ea_ptr, 4, \0              -- Start of EA:  flag byte
  274.    poke ea_ptr, 5, chr(name_len)
  275.    poke ea_ptr, 6, atoi(data_len + 4)     -- Value length = len(data) + len(data_type) + len(data_len)
  276.    poke ea_ptr, 8, name
  277.    poke ea_ptr, 8+name_len, \0     -- Null byte after name
  278.    poke ea_ptr, 9+name_len, \253\255        -- EAT_ASCII
  279.    poke ea_ptr, 11+name_len, atoi(data_len)
  280.    poke ea_ptr, 13+name_len, data
  281.    .eaarea = mpfrom2short(ea_ptr,0)
  282.  
  283. ; Dependencies:  None
  284. defc set_ea_many =            -- Sets a bunch of attributes.
  285.    if arg(1)='' then
  286.       sayerror 'SET_EA_MANY /<name> <value>/<name> <value>/... sets extended attributes for a new file *only*.'
  287.       return
  288.    endif
  289.    parse arg delim 2 rest
  290.    ea_len = 4                 -- Initialize to 4 bytes for FEALIST Length field
  291.    do while rest <> ''
  292.       parse value rest with stuff (delim) rest
  293.       parse value stuff with name data
  294.       ea_len = ea_len + length(name) + length(data) + 9   -- 9 bytes overhead per EA
  295.    enddo
  296.    if .eaarea then
  297.       ea_long = atol(.eaarea)
  298.       ea_seg = itoa(rightstr(ea_long,2),10)
  299.       ea_ofs = itoa(leftstr(ea_long,2),10)
  300.       ea_old_len  = ltoa(peek(ea_seg, ea_ofs, 4),10)
  301.       if ea_old_len > 4 then
  302.          sayerror '.eaarea already set; this example is only for newly-created edit files.'
  303.          return
  304.       endif
  305.       r =  dynalink('DOSCALLS',           -- Dynamic link library name
  306.                '#38',                     -- DosReAllocSeg
  307.                atoi(ea_len)           ||  -- Number of bytes requested
  308.                rightstr(ea_long,2) )
  309.       re = 're'
  310.       ea_ptr = ea_seg
  311.    else
  312.       ea_buffer = "00"                    -- Initialize string pointer.
  313.       r =  dynalink('DOSCALLS',           -- Dynamic link library name
  314.                '#34',                     -- DosAllocSeg
  315.                atoi(ea_len)           ||  -- Number of bytes requested
  316.                selector(ea_buffer)    ||  -- String selector
  317.                offset(ea_buffer)      ||  -- String offset
  318.                atoi(0) )                  -- Share information
  319.       re = ''
  320.       ea_ptr = itoa(ea_buffer,10)
  321.    endif
  322.  
  323.    if r then sayerror 'Error' r re'allocating memory segment; command halted.'; stop; endif
  324.    poke ea_ptr, 0, atol(ea_len)
  325.  
  326.    parse arg delim 2 rest
  327.    ea_ofs = 4                 -- Point to start of EA
  328.    do while rest <> ''
  329.       parse value rest with stuff (delim) rest
  330.       parse value stuff with name data
  331.       name_len = length(name)
  332.       data_len = length(data)
  333.       poke ea_ptr, ea_ofs  , \0              -- Start of EA:  flag byte
  334.       poke ea_ptr, ea_ofs+1, chr(name_len)
  335.       poke ea_ptr, ea_ofs+2, atoi(data_len + 4)     -- Value length = len(data) + len(data_type) + len(data_len)
  336.       poke ea_ptr, ea_ofs+4, name
  337.       poke ea_ptr, ea_ofs+4+name_len, \0     -- Null byte after name
  338.       poke ea_ptr, ea_ofs+5+name_len, EAT_ASCII
  339.       poke ea_ptr, ea_ofs+7+name_len, atoi(data_len)
  340.       poke ea_ptr, ea_ofs+9+name_len, data
  341.       ea_ofs = ea_ofs + name_len + data_len + 9   -- 9 bytes overhead per EA
  342.    enddo
  343.    .eaarea = mpfrom2short(ea_ptr,0)
  344.  
  345. ; Dependencies:  None
  346. defc addea, add_ea =                 -- Adds a single name / value pair to an existing EA list
  347.    parse arg name data
  348.    if name='' then
  349.       sayerror 'ADD_EA <name> <value> adds the extended attribute value specified to the current file.'
  350.       return
  351.    endif
  352.    name_len = length(name)
  353.    data_len = length(data)
  354.    ea_len_incr = 9 + name_len + data_len
  355.    if .eaarea then
  356.       ea_long = atol(.eaarea)
  357.       ea_seg = itoa(rightstr(ea_long,2),10)
  358.       ea_ofs = itoa(leftstr(ea_long,2),10)
  359.       ea_old_len  = ltoa(peek(ea_seg, ea_ofs, 4),10)
  360.       r =  dynalink('DOSCALLS',           -- Dynamic link library name
  361.                '#38',                     -- DosReAllocSeg
  362.                atoi(ea_old_len+ea_len_incr) ||  -- Number of bytes requested
  363.                rightstr(ea_long,2) )
  364.       re = 're'
  365.       ea_ptr = ea_seg
  366.    else
  367.       ea_buffer = "00"                    -- Initialize string pointer.
  368.       r =  dynalink('DOSCALLS',           -- Dynamic link library name
  369.                '#34',                     -- DosAllocSeg
  370.                atoi(ea_len_incr+4)    ||  -- Number of bytes requested
  371.                selector(ea_buffer)    ||  -- String selector
  372.                offset(ea_buffer)      ||  -- String offset
  373.                atoi(0) )                  -- Share information
  374.       re = ''
  375.       ea_ptr = itoa(ea_buffer,10)
  376.       ea_ofs = 0
  377.       ea_old_len  = 4           -- Point past length field
  378.    endif
  379.  
  380.    if r then sayerror 'Error' r re'allocating memory segment; command halted.'; stop; endif
  381.    poke ea_ptr, ea_ofs, atol(ea_old_len+ea_len_incr)
  382.    ea_ofs = ea_ofs + ea_old_len
  383.    poke ea_ptr, ea_ofs  , \0              -- Start of EA:  flag byte
  384.    poke ea_ptr, ea_ofs+1, chr(name_len)
  385.    poke ea_ptr, ea_ofs+2, atoi(data_len + 4)     -- Value length = len(data) + len(data_type) + len(data_len)
  386.    poke ea_ptr, ea_ofs+4, name
  387.    poke ea_ptr, ea_ofs+4+name_len, \0     -- Null byte after name
  388.    poke ea_ptr, ea_ofs+5+name_len, EAT_ASCII
  389.    poke ea_ptr, ea_ofs+7+name_len, atoi(data_len)
  390.    poke ea_ptr, ea_ofs+9+name_len, data
  391.    .eaarea = mpfrom2short(ea_ptr,0)
  392.  
  393. ; Dependencies:  find_ea()
  394. defc get_ea2, getea2 =        -- Tells you the value for a given attribute name
  395.    parse arg name .           -- (This version uses find_ea() instead of get_ea_value().)
  396.    if name='' then
  397.       sayerror 'GET_EA <name> tells you the extended attribute value for the given attribute name.'
  398.       return
  399.    endif
  400.    if find_ea(name, ea_seg, ea_ofs, ea_ptr1, ea_ptr2, ea_len, ea_entrylen, ea_valuelen) then
  401.       val = peek(ea_seg, ea_ptr2,min(ea_valuelen,255))
  402.       if leftstr(val,2)=\253\255 then      -- x'FFFD', after byte reversal
  403.          stuff = 'EAT_ASCII ('itoa(substr(val,3,2),10)') '
  404.          val = substr(val,5)
  405.       else
  406.          stuff = ''
  407.       endif
  408.       sayerror name'='stuff'"'val'"'
  409.    else
  410.       sayerror '<Not found>'
  411.    endif
  412.  
  413. ; Dependencies:  find_ea()
  414. defc delete_ea, deleteea =
  415.    parse arg name .
  416.    if name='' then
  417.       sayerror 'DELETE_EA <name> deletes the named extended attribute.'
  418.       return
  419.    endif
  420.    if not find_ea(name, ea_seg, ea_ofs, ea_ptr1, ea_ptr2, ea_len, ea_entrylen, ea_valuelen) then
  421.       sayerror '<Not found>'
  422.       return
  423.    endif
  424.    newlen = ea_len - ea_entrylen
  425.    poke ea_seg, ea_ofs, atol(newlen)
  426.    if ea_ptr1+ea_entrylen < ea_len then  -- If in the middle, close it up
  427.       call memcpyx(atoi(ea_ptr1) || atoi(ea_seg), atoi(ea_ptr1+ea_entrylen) || atoi(ea_seg), ea_len - ea_ptr1 - ea_entrylen)
  428.    endif
  429.    r =  dynalink('DOSCALLS',           -- Dynamic link library name
  430.             '#38',                     -- DosReAllocSeg
  431.             atoi(newlen)           ||  -- Number of bytes requested
  432.             atoi(ea_seg) )
  433. ;; if r then sayerror 'Error' r 'reallocating memory segment; command halted.'; stop; endif
  434.  
  435. ; Dependencies:  find_ea()
  436. defproc delete_ea(name) =
  437.    parse arg name .
  438.    if not find_ea(name, ea_seg, ea_ofs, ea_ptr1, ea_ptr2, ea_len, ea_entrylen, ea_valuelen) then
  439.       return
  440.    endif
  441.    newlen = ea_len - ea_entrylen
  442.    poke ea_seg, ea_ofs, atol(newlen)
  443.  junk = 'junk'  -- Avoid problem due to bug in MEMCPYX in EPM 5.20
  444.    if ea_ptr1+ea_entrylen < ea_len then  -- If in the middle, close it up
  445.       call memcpyx(atoi(ea_ptr1) || atoi(ea_seg), atoi(ea_ptr1+ea_entrylen) || atoi(ea_seg), ea_len - ea_ptr1 - ea_entrylen)
  446.    endif
  447.    call dynalink('DOSCALLS',           -- Dynamic link library name
  448.             '#38',                     -- DosReAllocSeg
  449.             atoi(newlen)           ||  -- Number of bytes requested
  450.             atoi(ea_seg) )
  451.  
  452. ; Dependencies:  find_ea(), delete_ea(), add_ea
  453. defc type =
  454.    found = find_ea('.TYPE', ea_seg, ea_ofs, ea_ptr1, ea_ptr2, ea_len, ea_entrylen, ea_valuelen)
  455.    if not found | ea_valuelen=0 then
  456.       answer = winmessagebox('Type', 'File has no type.  Would you like to set one?', 16388) -- YESNO + MOVEABLE
  457.    elseif peek(ea_seg, ea_ptr2, 2)=EAT_ASCII then
  458.       type = peek(ea_seg, ea_ptr2+4, min(itoa(peek(ea_seg, ea_ptr2+2, 2), 10), 255))
  459.       answer = winmessagebox('Type', 'File has the following type:'\13 type\13\13'Would you like to change it?', 16388) -- YESNO + MOVEABLE
  460.    elseif peek(ea_seg, ea_ptr2, 2)=EAT_MVMT then
  461.       ea_numentries = itoa(peek(ea_seg, ea_ptr2+4, 2),10)
  462.       if ea_numentries=1 then
  463.          type = 'File has the following type:'
  464.       else
  465.          type = 'File has types:'
  466.       endif
  467.       ea_entry_ofs = ea_ptr2+6
  468.       do i=1 to ea_numentries
  469.          ea_entrylen = itoa(peek(ea_seg, ea_entry_ofs+2, 2),10)
  470.          if peek(ea_seg, ea_entry_ofs, 2)=EAT_ASCII then
  471.             type = type\13 || peek(ea_seg, ea_entry_ofs+4,min(ea_entrylen,255))
  472.          else
  473.             type = type\13 || '<non-ASCII>'
  474.          endif
  475.          ea_entry_ofs = ea_entry_ofs + ea_entrylen + 4
  476.       enddo
  477.       answer = winmessagebox('Type', type\13\13'Would you like to change it?', 16388) -- YESNO + MOVEABLE
  478.    else
  479.       answer = winmessagebox('Type', 'File has non-ASCII data for the type.'\13'Would you like to change it?', 16388) -- YESNO + MOVEABLE
  480.    endif
  481.    if answer=6 then
  482.       newtype = listbox('Select type','-Plain Text-OS/2 Command File-DOS Command File-C Code-Pascal Code-BASIC Code-COBOL Code-FORTRAN Code-Assembler Code-')
  483.       if newtype then
  484.          if found then call delete_ea('.TYPE'); endif
  485.          'add_ea .TYPE' newtype
  486.       endif
  487.    endif
  488.  
  489. ; Dependencies:  delete_ea(), add_ea
  490. defc setattribute, setfiletype
  491.    call delete_ea('.TYPE')
  492.    'add_ea .TYPE' arg(1)
  493.  
  494. ; Dependencies:  find_ea(), delete_ea(), add_ea
  495. defc subject =
  496.    found = find_ea('.SUBJECT', ea_seg, ea_ofs, ea_ptr1, ea_ptr2, ea_len, ea_entrylen, ea_valuelen)
  497.    subj = ''
  498.    if not found | ea_valuelen=0 then
  499.       answer = winmessagebox('Subject', 'File has no subject.  Would you like to add one?', 16388) -- YESNO + MOVEABLE
  500.    elseif peek(ea_seg, ea_ptr2, 2)=EAT_ASCII then
  501.       subj = peek(ea_seg, ea_ptr2+4, min(itoa(peek(ea_seg, ea_ptr2+2, 2), 10), 255))
  502.       answer = winmessagebox('Subject', 'File has the following subject:'\13 subj\13\13'Would you like to change it?', 16388) -- YESNO + MOVEABLE
  503.    else
  504.       answer = winmessagebox('Subject', 'File has non-ASCII data for the subject.'\13'Would you like to change it?', 16388) -- YESNO + MOVEABLE
  505.    endif
  506.    if answer=6 then
  507.       newsubj = entrybox('Enter subject', '', subj, 40, 40)
  508.       if newsubj then
  509.          if found then call delete_ea('.SUBJECT'); endif
  510.          'add_ea .SUBJECT' newsubj
  511.       endif
  512.    endif
  513.  
  514. ; The following routine will put the contents of the current file into the
  515. ; .EAarea of another file as an MVST EAT_ASCII attribute.  If the given
  516. ; attribute name already exists, it will be replaced (not extended).
  517. ; Dependencies:  delete_ea()
  518. defproc put_file_as_MVST(source_fid, target_fid, ea_name)
  519.    getfileid start_fid
  520.    activatefile target_fid
  521.    call delete_ea(ea_name)
  522.    if not source_fid.last then  -- If nothing to add,
  523.       activatefile start_fid
  524.       return                    -- we're all done.
  525.    endif
  526.    name_len = length(ea_name)
  527.    value_len = filesize() + 2 * .last + 8  -- Overhead: 2 bytes/rec length, + 2 bytes each EAT_MVST, codepage, numentries, EAT_ASCII
  528.    ea_len_incr = 5 + name_len + value_len  -- Overhead: 1 flags, 1 len(name), 2 len(value), 1 null ASCIIZ terminator
  529.    if .eaarea then
  530.       ea_long = atol(.eaarea)
  531.       ea_seg = itoa(rightstr(ea_long,2),10)
  532.       ea_ofs = itoa(leftstr(ea_long,2),10)
  533.       ea_old_len  = ltoa(peek(ea_seg, ea_ofs, 4),10)
  534.       r =  dynalink('DOSCALLS',           -- Dynamic link library name
  535.                '#38',                     -- DosReAllocSeg
  536.                atoi(ea_old_len+ea_len_incr) ||  -- Number of bytes requested
  537.                rightstr(ea_long,2) )
  538.       re = 're'
  539.       ea_ptr = ea_seg
  540.    else
  541.       ea_buffer = "00"                    -- Initialize string pointer.
  542.       r =  dynalink('DOSCALLS',           -- Dynamic link library name
  543.                '#34',                     -- DosAllocSeg
  544.                atoi(ea_len_incr+4)    ||  -- Number of bytes requested
  545.                selector(ea_buffer)    ||  -- String selector
  546.                offset(ea_buffer)      ||  -- String offset
  547.                atoi(0) )                  -- Share information
  548.       re = ''
  549.       ea_ptr = itoa(ea_buffer,10)
  550.       ea_ofs = 0
  551.       ea_old_len  = 4           -- Point past length field
  552.    endif
  553.  
  554.    if r then sayerror 'Error' r re'allocating memory segment; command halted.'; stop; endif
  555.    poke ea_ptr, ea_ofs, atol(ea_old_len+ea_len_incr)
  556.    ea_ofs = ea_ofs + ea_old_len
  557.    poke ea_ptr, ea_ofs  , \0              -- Start of EA:  flag byte
  558.    poke ea_ptr, ea_ofs+1, chr(name_len)
  559.    poke ea_ptr, ea_ofs+2, atoi(value_len)
  560.    poke ea_ptr, ea_ofs+4, ea_name
  561.    poke ea_ptr, ea_ofs+4+name_len, \0     -- Null byte after name
  562.    poke ea_ptr, ea_ofs+5+name_len, EAT_MVST
  563.    poke ea_ptr, ea_ofs+7+name_len, atoi(0)  -- Code page
  564.    poke ea_ptr, ea_ofs+9+name_len, atoi(source_fid.last)  -- NumEntries
  565.    poke ea_ptr, ea_ofs+11+name_len, EAT_ASCII  -- Each entry is of type ASCII
  566.    ea_ofs = ea_ofs + 13 + name_len
  567.    do i=1 to source_fid.last
  568.       getline line, i, source_fid
  569.       poke ea_ptr, ea_ofs, atoi(length(line))
  570.       poke ea_ptr, ea_ofs+2, line
  571.       ea_ofs = ea_ofs + length(line) + 2
  572.    enddo
  573.    .eaarea = mpfrom2short(ea_ptr,0)
  574.    activatefile start_fid
  575.  
  576. ; EPM.Attributes will save EPM attributes listed in current file into the .EAarea
  577. defc try_EPM_EA =
  578.    getfileid source_fid
  579.    call put_file_as_MVST(source_fid, source_fid, 'EPM.Attributes')
  580.  
  581. ; Dependencies:  delete_ea(), add_ea
  582. defc putfield  -- Put a field into an EA
  583.    field = upcase(strip(arg(1)))
  584.    if leftstr(field,1)='.' then
  585.       field=substr(field,2)
  586.    endif
  587.    if field = '' then
  588.       Sayerror 'Supported fields are:  FIlename MArgins TAbs TItletext Userstring'
  589.       return
  590.    elseif abbrev('FILENAME', field, 2) then
  591.       parse value 'FILENAME' .filename with fieldname fieldvalue
  592.    elseif abbrev('MARGINS', field, 2) then
  593.       parse value 'MARGINS' .margins with fieldname fieldvalue
  594.    elseif abbrev('TABS', field, 2) then
  595.       parse value 'TABS' .tabs with fieldname fieldvalue
  596.    elseif abbrev('TITLETEXT', field, 2) then
  597.       parse value 'TITLETEXT' .titletext with fieldname fieldvalue
  598.    elseif abbrev('USERSTRING', field, 1) then
  599.       parse value 'USERSTRING' .userstring with fieldname fieldvalue
  600.    else
  601.       sayerror 'Unknown or unsupported field:  'field
  602.       return
  603.    endif
  604.    call delete_ea('EPM.'fieldname)
  605.    'add_ea EPM.'fieldname fieldvalue
  606.  
  607. ; Dependencies:  check_field()
  608. defc getfield  -- Recover a field from an EA
  609.    field = upcase(strip(arg(1)))
  610.    if leftstr(field,1)='.' then
  611.       field=substr(field,2)
  612.    endif
  613.    if abbrev('FILENAME', field, 2) then
  614.      .filename = check_field('FILENAME', .filename)
  615.    elseif abbrev('MARGINS', field, 2) then
  616.      .margins = check_field('MARGINS', .margins)
  617.    elseif abbrev('TABS', field, 2) then
  618.      .tabs = check_field('TABS', .tabs)
  619.    elseif abbrev('TITLETEXT', field, 2) then
  620.      .titletext = check_field('TITLETEXT', .titletext)
  621.    elseif abbrev('USERSTRING', field, 1) then
  622.      .userstring = check_field('USERSTRING', .userstring)
  623.    else
  624.       sayerror 'Unknown or unsupported field:  'field
  625.       return
  626.    endif
  627.  
  628. ; Dependencies:  get_ea_value()
  629. defproc check_field(fieldname, current_value)
  630.    val = get_ea_value('EPM.'fieldname)
  631.    if leftstr(val,2)=\253\255 then      -- x'FFFD', after byte reversal
  632.       return substr(val,5)              -- (EAT_ASCII)
  633.    elseif val='' then
  634.       sayerror 'Field value not found in extended attribute area.'
  635.    else
  636.       sayerror 'Saved as unsupported EA type:  'itoa(leftstr(val,2),16)
  637.    endif
  638.    return current_value
  639.  
  640.