X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5553563924453df2e3c5bf011bf5b7527172b2f6..1eedd2f11f54db9ccc9a9b6cae639f65750b8baf:/lisp/gs.el

diff --git a/lisp/gs.el b/lisp/gs.el
index 1399e4258a..8f9414f0e5 100644
--- a/lisp/gs.el
+++ b/lisp/gs.el
@@ -1,6 +1,7 @@
 ;;; gs.el --- interface to Ghostscript
 
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -19,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -39,12 +40,14 @@
 (defvar gs-options
   '("-q"
     ;"-dNOPAUSE"
+    "-dSAFER"
     "-dBATCH"
     "-sDEVICE=<device>"
     "<file>")
   "List of command line arguments to pass to Ghostscript.
 Arguments may contain place-holders `<file>' for the name of the
 input file, and `<device>' for the device to use.")
+(put 'gs-options 'risky-local-variable t)
 
 (defun gs-options (device file)
   "Return a list of command line options with place-holders replaced.
@@ -55,7 +58,6 @@ FILE is the value to substitute for the place-holder `<file>'."
 		    option (replace-regexp-in-string "<file>" file option)))
 	  gs-options))
 
-
 ;; The GHOSTVIEW property (taken from gv 3.5.8).
 ;;
 ;; Type:
@@ -115,10 +117,10 @@ SPEC is a GS image specification.  IMG-WIDTH is the width of the
 requested image, and IMG-HEIGHT is the height of the requested
 image in pixels."
   (let* ((box (plist-get (cdr spec) :bounding-box))
-	 (llx (nth 0 box))
-	 (lly (nth 1 box))
-	 (urx (nth 2 box))
-	 (ury (nth 3 box))
+	 (llx (elt box 0))
+	 (lly (elt box 1))
+	 (urx (elt box 2))
+	 (ury (elt box 3))
 	 (rotation (or (plist-get (cdr spec) :rotate) 0))
 	 ;; The pixel width IMG-WIDTH of the pixmap gives the
 	 ;; dots, URX - LLX give the inch.
@@ -138,7 +140,8 @@ image in pixels."
 		    ((x-display-grayscale-p frame) "Grayscale")
 		    (t "Monochrome"))))
     (x-change-window-property "GHOSTVIEW_COLORS"
-			      (format "%s %s" mode pixel-colors))))
+			      (format "%s %s" mode pixel-colors)
+			      frame)))
 
 
 ;
@@ -151,13 +154,51 @@ and height of the image in pixels.  WINDOW-AND-PIXMAP-ID is a string of
 the form \"WINDOW-ID PIXMAP-ID\".  Value is non-nil if successful."
   (unwind-protect
       (let ((file (plist-get (cdr spec) :file))
-	    gs)
+	    gs
+ 	    (timeout 40))
+ 	;; Wait while property gets freed from a previous ghostscript process
+ 	;; sit-for returns nil as soon as input starts being
+	;; available, so if we want to give GhostScript a reasonable
+ 	;; chance of starting up, we better use sleep-for.  We let
+ 	;; sleep-for wait only half the time because if input is
+ 	;; available, it is more likely that we don't care that much
+ 	;; about garbled redisplay and are in a hurry.
+ 	(while (and
+ 		;; Wait while the property is not yet available
+ 		(not (zerop (length (x-window-property "GHOSTVIEW"
+ 						       frame))))
+ 		;; The following was an alternative condition: wait
+ 		;; while there is still a process running.  The idea
+ 		;; was to avoid contention between processes.  Turned
+ 		;; out even more sluggish.
+ 		;; (get-buffer-process "*GS*")
+ 		(not (zerop timeout)))
+ 	  (unless (sit-for 0 100 t)
+ 	    (sleep-for 0 50))
+ 	  (setq timeout (1- timeout)))
+
+ 	;; No use waiting longer.  We might want to try killing off
+ 	;; stuck processes, but there is no point in doing so: either
+ 	;; they are stuck for good, in which case the user would
+ 	;; probably be responsible for that, and killing them off will
+ 	;; make debugging harder, or they are not.  In that case, they
+ 	;; will cause incomplete displays.  But the same will happen
+ 	;; if they are killed, anyway. The whole is rather
+ 	;; disconcerting, and fast scrolling through a dozen images
+ 	;; will make Emacs freeze for a while.  The alternatives are a)
+ 	;; proper implementation not waiting at all but creating
+ 	;; appropriate queues, or b) permanently bad display due to
+ 	;; bad cached images.  So remember that this
+ 	;; is just a hack and if people don't like the behaviour, they
+ 	;; will most likely like the easy alternatives even less.
+ 	;; And at least the image cache will make the delay apparent
+ 	;; just once.
 	(gs-set-ghostview-window-prop frame spec img-width img-height)
 	(gs-set-ghostview-colors-window-prop frame pixel-colors)
 	(setenv "GHOSTVIEW" window-and-pixmap-id)
 	(setq gs (apply 'start-process "gs" "*GS*" gs-program
 			(gs-options gs-device file)))
-	(process-kill-without-query gs)
+	(set-process-query-on-exit-flag gs nil)
 	gs)
     nil))
 
@@ -173,4 +214,5 @@ the form \"WINDOW-ID PIXMAP-ID\".  Value is non-nil if successful."
 
 (provide 'gs)
 
+;;; arch-tag: 06ab51b8-4932-4cfe-9f60-b924a8edb3f0
 ;;; gs.el ends here