1
0

gs_diskn.ps 6.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214
  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. % $Id: gs_diskn.ps,v 1.5 2003/08/08 18:45:04 ray Exp $
  16. % Initialization file for %disk device modifications
  17. % When this is run, systemdict is still writable,
  18. systemdict begin
  19. % Collect the list of searchable IODevices in SearchOrder
  20. % Efficiency here doesn't matter since we run this at the end
  21. % of gs_init and convert it to a static array.
  22. /.getsearchabledevs { % - .getsearchabledevs [ list_of_strings ]
  23. //systemdict /.searchabledevs .knownget not {
  24. .currentglobal true .setglobal
  25. mark (*) {
  26. dup length string copy dup currentdevparams /Searchable
  27. .knownget { not { pop } if } { pop } ifelse
  28. } 8192 string /IODevice resourceforall
  29. ]
  30. % now process the array into correct SearchOrder
  31. 0 1 2 {
  32. mark exch 2 index {
  33. dup currentdevparams /SearchOrder get 2 index eq
  34. { exch } { pop } ifelse
  35. } forall % devices on the old list
  36. pop
  37. % make the array and sort it by name
  38. ] { lt } bind .sort
  39. exch
  40. } for
  41. % collect all devices with SearchOrder > 2
  42. mark 2 index {
  43. dup currentdevparams /SearchOrder get 2 gt
  44. { exch } { pop } ifelse
  45. } forall
  46. ] exch pop
  47. % We now have 4 arrays on the stack, SO=0 SO=1 SO=2 SO>2
  48. % make them into a single array
  49. mark 5 1 roll ] mark exch { { } forall } forall ]
  50. //systemdict /.searchabledevs 2 index .forceput
  51. exch .setglobal
  52. }
  53. if
  54. } .bind executeonly def % must be bound and hidden for .forceput
  55. % Modify .putdevparams to force regeneration of .searchabledevs list
  56. /.putdevparams {
  57. % We could be smarter and check for %disk* device, but this
  58. % doesn't get run enough to justify the complication
  59. //.putdevparams
  60. //systemdict /.searchabledevs .forceundef
  61. } .bind odef % must be bound and hidden for .forceundef
  62. % ------ extend filenameforall to handle wildcards in %dev% part of pattern -------%
  63. /filenameforall {
  64. count 3 ge {
  65. 2 index (%) search {
  66. pop pop
  67. } {
  68. % no device specified, so search them all
  69. pop (*%) 3 index concatstrings
  70. % we need to suppress the device when we return the string
  71. % in order to match Adobe's behaviour with %disk devices.
  72. 4 -2 roll % the callers procedure
  73. [ { (%) search { pop pop (%) search { pop pop } if } if } /exec load
  74. 4 -1 roll % the callers procedure
  75. /exec load
  76. ] cvx
  77. 4 2 roll % put the modified procedure where it belongs
  78. } ifelse
  79. % extract device portion (up to end of string or next %)
  80. (%) search { exch pop } if % stack: opat proc scratch npat device
  81. dup (*) search { pop pop pop true } { pop false } ifelse
  82. 1 index (?) search { pop pop pop true } { pop false } ifelse
  83. or not {
  84. pop pop //filenameforall % device with no wildcard
  85. } {
  86. (%) concatstrings (%) exch concatstrings
  87. .getsearchabledevs
  88. % find all matching devices and add the rest of the search string
  89. mark exch {
  90. dup counttomark 1 add index .stringmatch {
  91. counttomark 2 add index concatstrings
  92. } {
  93. pop
  94. } ifelse
  95. } forall
  96. ]
  97. 3 1 roll pop pop
  98. 4 -1 roll pop
  99. % now we need to invoke filenameforall for each of the strings
  100. % in the array. We do this by building a procedure that is like
  101. % an unrolled 'forall' loop. We do this to get the parameters
  102. % for each filenameforall, since each execution will pop its
  103. % parameters, but we can't use the operand stack for storage
  104. % since each invocation must have the same operand stack.
  105. mark exch {
  106. counttomark dup 3 add index exch
  107. 2 add index
  108. /filenameforall load
  109. } forall
  110. ] cvx
  111. 3 1 roll pop pop
  112. exec % run our unrolled loop
  113. }
  114. ifelse
  115. } {
  116. //filenameforall % not enough parameters -- just let it fail
  117. }
  118. ifelse
  119. } odef
  120. % redefine file to search all devices in order
  121. /file {
  122. dup 0 get (r) 0 get eq dup {
  123. pop false % success code
  124. 2 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
  125. { 3 index concatstrings % prepend the device
  126. {
  127. 2 index //file } .internalstopped not {
  128. 4 1 roll pop pop pop true
  129. exit % exit with success
  130. } {
  131. pop pop
  132. }
  133. ifelse
  134. }
  135. forall
  136. }
  137. if
  138. not { % just let standard file operator handle things
  139. //file
  140. }
  141. if
  142. } bind odef
  143. % redefine deletefile to search all devices in order
  144. /deletefile {
  145. false % success code
  146. 1 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
  147. { 2 index concatstrings % prepend the device
  148. { //deletefile } .internalstopped exch pop not {
  149. pop true exit % exit with success
  150. }
  151. if
  152. }
  153. forall
  154. not { $error /errorname get /deletefile exch signalerror } if
  155. } bind odef
  156. % redefine status to search all devices in order
  157. /status {
  158. dup type /stringtype eq {
  159. false % success code
  160. 1 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
  161. { 2 index concatstrings % prepend the device
  162. { //status } .internalstopped not {
  163. { true 7 -2 roll pop pop true exit } % exit with success
  164. if
  165. }
  166. if
  167. }
  168. forall
  169. % If we made it this far, no devices were found to status the file
  170. % clean up to return 'false'
  171. exch pop
  172. } {
  173. //status
  174. }
  175. ifelse
  176. } bind odef
  177. % Also redefine renamefile to search all devices in order
  178. /renamefile {
  179. false % success code
  180. 2 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
  181. { dup 4 index concatstrings % prepend the device
  182. { (r) //file } .internalstopped
  183. not {
  184. closefile exch pop true exit % exit with success
  185. } {
  186. pop pop
  187. } ifelse
  188. }
  189. forall
  190. not { $error /errorname get /renamefile exch signalerror } if
  191. 3 -1 roll concatstrings exch
  192. //renamefile
  193. } bind odef
  194. % redefine devforall to process devices in numeric order
  195. % Spec's for 'devforall' are unclear, but font downloaders may expect this
  196. /devforall { % <proc> <scratch> devforall -
  197. [ { dup length string copy } 2 index //devforall ]
  198. % stack: proc scratch array_of_device_names
  199. { lt } .sort
  200. % We don't really invoke the procedure with the scratch string
  201. % but rather with the strings from our array
  202. exch pop exch forall
  203. } odef
  204. end % systemdict