home *** CD-ROM | disk | FTP | other *** search
/ jppd.dyndns.org / jppd.dyndns.org.tar / jppd.dyndns.org / QUERYPRO / Impressora_PDF / converter.exe / GPLGS / gs_diskn.ps < prev    next >
Text File  |  2003-12-13  |  7KB  |  215 lines
  1. %    Copyright (C) 1990, 2000 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This software is provided AS-IS with no warranty, either express or
  4. % implied.
  5. % 
  6. % This software is distributed under license and may not be copied,
  7. % modified or distributed except as expressly authorized under the terms
  8. % of the license contained in the file LICENSE in this distribution.
  9. % 
  10. % For more information about licensing, please refer to
  11. % http://www.ghostscript.com/licensing/. For information on
  12. % commercial licensing, go to http://www.artifex.com/licensing/ or
  13. % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  14. % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  15.  
  16. % $Id: gs_diskn.ps,v 1.4.2.1 2003/12/12 22:07:58 giles Exp $
  17. % Initialization file for %disk device modifications
  18. % When this is run, systemdict is still writable,
  19.  
  20. systemdict begin
  21.  
  22. % Collect the list of searchable IODevices in SearchOrder
  23. % Efficiency here doesn't matter since we run this at the end
  24. % of gs_init and convert it to a static array.
  25. /.getsearchabledevs { % - .getsearchabledevs [ list_of_strings ]
  26.   //systemdict /.searchabledevs .knownget not {
  27.     .currentglobal true .setglobal
  28.     mark (*) { 
  29.       dup length string copy dup currentdevparams /Searchable
  30.       .knownget { not { pop } if } { pop } ifelse
  31.     } 8192 string /IODevice resourceforall
  32.     ]
  33.     % now process the array into correct SearchOrder
  34.     0 1 2 {
  35.       mark exch 2 index {
  36.     dup currentdevparams /SearchOrder get 2 index eq
  37.     { exch } { pop } ifelse
  38.       } forall % devices on the old list
  39.       pop
  40.       % make the array and sort it by name
  41.       ] { lt } bind .sort 
  42.       exch
  43.     } for
  44.     % collect all devices with SearchOrder > 2
  45.     mark 2 index {
  46.       dup currentdevparams /SearchOrder get 2 gt 
  47.       { exch } { pop } ifelse
  48.     } forall 
  49.     ] exch pop
  50.     % We now have 4 arrays on the stack, SO=0 SO=1 SO=2 SO>2
  51.     % make them into a single array
  52.     mark 5 1 roll ] mark exch { { } forall } forall ]
  53.     //systemdict /.searchabledevs 2 index .forceput
  54.     exch .setglobal
  55.   }
  56.   if
  57. } .bind executeonly def % must be bound and hidden for .forceput
  58.  
  59. % Modify .putdevparams to force regeneration of .searchabledevs list
  60. /.putdevparams {
  61.   % We could be smarter and check for %disk* device, but this
  62.   % doesn't get run enough to justify the complication
  63.   //.putdevparams
  64.   //systemdict /.searchabledevs .forceundef  
  65. } .bind odef % must be bound and hidden for .forceundef
  66.  
  67. % ------ extend filenameforall to handle wildcards in %dev% part of pattern -------%
  68. /filenameforall {
  69.   count 3 ge {
  70.     2 index (%) search {
  71.       pop pop 
  72.     } {
  73.       % no device specified, so search them all
  74.       pop (*%) 3 index concatstrings
  75.       % we need to suppress the device when we return the string
  76.       % in order to match Adobe's behaviour with %disk devices.
  77.       4 -2 roll        % the callers procedure
  78.       [ { (%) search { pop pop (%) search { pop pop } if } if } /exec load
  79.         4 -1 roll        % the callers procedure
  80.         /exec load
  81.       ] cvx
  82.       4 2 roll        % put the modified procedure where it belongs
  83.     } ifelse
  84.     % extract device portion (up to end of string or next %)
  85.     (%) search { exch pop } if    % stack: opat proc scratch npat device
  86.     dup (*) search { pop pop pop true } { pop false } ifelse
  87.     1 index (?) search { pop pop pop true } { pop false } ifelse
  88.     or not {
  89.       pop pop //filenameforall    % device with no wildcard
  90.     } {
  91.       (%) concatstrings (%) exch concatstrings
  92.       .getsearchabledevs
  93.       % find all matching devices and add the rest of the search string
  94.       mark exch {
  95.           dup counttomark 1 add index .stringmatch {
  96.           counttomark 2 add index concatstrings
  97.         } {
  98.           pop
  99.         } ifelse
  100.       } forall
  101.       ]
  102.       3 1 roll pop pop
  103.       4 -1 roll pop 
  104.       % now we need to invoke filenameforall for each of the strings
  105.       % in the array. We do this by building a procedure that is like
  106.       % an unrolled 'forall' loop. We do this to get the parameters
  107.       % for each filenameforall, since each execution will pop its
  108.       % parameters, but we can't use the operand stack for storage
  109.       % since each invocation must have the same operand stack.
  110.       mark exch {
  111.           counttomark dup 3 add index exch
  112.           2 add index
  113.           /filenameforall load
  114.         } forall
  115.       ] cvx
  116.       3 1 roll pop pop
  117.       exec        % run our unrolled loop
  118.     }
  119.     ifelse
  120.   } {
  121.     //filenameforall    % not enough parameters -- just let it fail
  122.   }
  123.   ifelse
  124. } odef
  125.  
  126. % redefine file to search all devices in order
  127. /file {
  128.   dup 0 get (r) 0 get eq dup {
  129.     pop false                % success code
  130.     2 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
  131.     { 3 index concatstrings    % prepend the device
  132.       {
  133.         2 index //file } .internalstopped not {
  134.     4 1 roll pop pop pop true
  135.     exit        % exit with success
  136.       } {
  137.         pop pop
  138.       }
  139.       ifelse
  140.     }
  141.     forall
  142.   }
  143.   if
  144.   not {        % just let standard file operator handle things
  145.     //file
  146.   }
  147.   if
  148. } bind odef
  149.  
  150. % redefine deletefile to search all devices in order
  151. /deletefile {
  152.   false                % success code
  153.   1 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
  154.   { 2 index concatstrings    % prepend the device
  155.     { //deletefile } .internalstopped exch pop not {
  156.       pop true exit        % exit with success
  157.     }
  158.     if
  159.   }
  160.   forall
  161.   not { $error /errorname get /deletefile exch signalerror } if
  162. } bind odef
  163.  
  164. % redefine status to search all devices in order
  165. /status {
  166.   dup type /stringtype eq {
  167.     false                % success code
  168.     1 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
  169.     { 2 index concatstrings    % prepend the device
  170.       { //status } .internalstopped not {
  171.         { true 7 -2 roll pop pop true exit } % exit with success
  172.     if
  173.       }
  174.       if
  175.     }
  176.     forall
  177.     % If we made it this far, no devices were found to status the file
  178.         % clean up to return 'false'
  179.     exch pop
  180.   } {
  181.     //status
  182.   }
  183.   ifelse
  184. } bind odef
  185.  
  186. % Also redefine renamefile to search all devices in order
  187. /renamefile {
  188.   false                % success code
  189.   2 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
  190.   { dup 4 index concatstrings    % prepend the device
  191.     { (r) //file } .internalstopped
  192.     not {
  193.       closefile exch pop true exit    % exit with success
  194.     } {
  195.       pop pop
  196.     } ifelse
  197.   }
  198.   forall
  199.   not { $error /errorname get /renamefile exch signalerror } if
  200.   3 -1 roll concatstrings exch
  201.   //renamefile
  202. } bind odef
  203.  
  204. % redefine devforall to process devices in numeric order
  205. % Spec's for 'devforall' are unclear, but font downloaders may expect this
  206. /devforall {        % <proc> <scratch> devforall -
  207.   [ { dup length string copy } 2 index //devforall ]    
  208.   % stack: proc scratch array_of_device_names
  209.   { lt } .sort
  210.   % We don't really invoke the procedure with the scratch string
  211.   % but rather with the strings from our array
  212.   exch pop exch forall
  213. } odef
  214. end                % systemdict
  215.