aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2009-01-10 13:04:37 +0000
committerChong Yidong2009-01-10 13:04:37 +0000
commit6c1ec5a0505cce365e272bce948258b276b29142 (patch)
tree815273c44e4452785d618af626c3bb6fa5b7b0b8
parent53ed745ab7978c8ece696a78807cbdda72fc5dd2 (diff)
downloademacs-6c1ec5a0505cce365e272bce948258b276b29142.tar.gz
emacs-6c1ec5a0505cce365e272bce948258b276b29142.zip
* gs.el: File removed.
-rw-r--r--lisp/ChangeLog2
-rw-r--r--lisp/frame.el17
-rw-r--r--lisp/gs.el225
-rw-r--r--lisp/server.el36
4 files changed, 22 insertions, 258 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7e07d87f753..ba9a2120352 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,7 @@
12009-01-10 Chong Yidong <cyd@stupidchicken.com> 12009-01-10 Chong Yidong <cyd@stupidchicken.com>
2 2
3 * gs.el: File removed.
4
3 * faces.el (x-font-family-list): Remove entirely. 5 * faces.el (x-font-family-list): Remove entirely.
4 6
52009-01-10 Eli Zaretskii <eliz@gnu.org> 72009-01-10 Eli Zaretskii <eliz@gnu.org>
diff --git a/lisp/frame.el b/lisp/frame.el
index c34e5d361f2..e886a517928 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -648,23 +648,6 @@ The optional argument PARAMETERS specifies additional frame parameters."
648 (make-frame `((window-system . x) 648 (make-frame `((window-system . x)
649 (display . ,display) . ,parameters))))) 649 (display . ,display) . ,parameters)))))
650 650
651(defun make-frame-on-tty (tty type &optional parameters)
652 "Make a frame on terminal device TTY.
653TTY should be the file name of the tty device to use. TYPE
654should be the terminal type string of TTY, for example \"xterm\"
655or \"vt100\". The optional third argument PARAMETERS specifies
656additional frame parameters."
657 ;; Use "F" rather than "f", in case the device does not exist, as
658 ;; far as the filesystem is concerned.
659 (interactive "FOpen frame on tty device: \nsTerminal type of %s: ")
660 (unless tty
661 (error "Invalid terminal device"))
662 (unless type
663 (error "Invalid terminal type"))
664 (if (eq window-system 'pc)
665 (make-frame `((window-system . pc) (tty . ,tty) (tty-type . ,type) . ,parameters))
666 (make-frame `((window-system . nil) (tty . ,tty) (tty-type . ,type) . ,parameters))))
667
668(declare-function x-close-connection "xfns.c" (terminal)) 651(declare-function x-close-connection "xfns.c" (terminal))
669 652
670(defun close-display-connection (display) 653(defun close-display-connection (display)
diff --git a/lisp/gs.el b/lisp/gs.el
deleted file mode 100644
index 69405d75e78..00000000000
--- a/lisp/gs.el
+++ /dev/null
@@ -1,225 +0,0 @@
1;;; gs.el --- interface to Ghostscript
2
3;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4;; 2008, 2009 Free Software Foundation, Inc.
5
6;; Maintainer: FSF
7;; Keywords: internal
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; This code is experimental. Don't use it.
27
28;;; Code:
29
30(defvar gs-program "gs"
31 "The name of the Ghostscript interpreter.")
32
33
34(defvar gs-device "x11"
35 "The Ghostscript device to use to produce images.")
36
37
38(defvar gs-options
39 '("-q"
40 ;"-dNOPAUSE"
41 "-dSAFER"
42 "-dBATCH"
43 "-sDEVICE=<device>"
44 "<file>")
45 "List of command line arguments to pass to Ghostscript.
46Arguments may contain place-holders `<file>' for the name of the
47input file, and `<device>' for the device to use.")
48(put 'gs-options 'risky-local-variable t)
49
50(defun gs-options (device file)
51 "Return a list of command line options with place-holders replaced.
52DEVICE is the value to substitute for the place-holder `<device>',
53FILE is the value to substitute for the place-holder `<file>'."
54 (mapcar #'(lambda (option)
55 (setq option (replace-regexp-in-string "<device>" device option)
56 option (replace-regexp-in-string "<file>" file option)))
57 gs-options))
58
59;; The GHOSTVIEW property (taken from gv 3.5.8).
60;;
61;; Type:
62;;
63;; STRING
64;;
65;; Parameters:
66;;
67;; BPIXMAP ORIENT LLX LLY URX URY XDPI YDPI [LEFT BOTTOM TOP RIGHT]
68;;
69;; Scanf format: "%d %d %d %d %d %d %f %f %d %d %d %d"
70;;
71;; Explanation of parameters:
72;;
73;; BPIXMAP: pixmap id of the backing pixmap for the window. If no
74;; pixmap is to be used, this parameter should be zero. This
75;; parameter must be zero when drawing on a pixmap.
76;;
77;; ORIENT: orientation of the page. The number represents clockwise
78;; rotation of the paper in degrees. Permitted values are 0, 90, 180,
79;; 270.
80;;
81;; LLX, LLY, URX, URY: Bounding box of the drawable. The bounding box
82;; is specified in PostScript points in default user coordinates.
83;;
84;; XDPI, YDPI: Resolution of window. (This can be derived from the
85;; other parameters, but not without roundoff error. These values are
86;; included to avoid this error.)
87;;
88;; LEFT, BOTTOM, TOP, RIGHT: (optional) Margins around the window.
89;; The margins extend the imageable area beyond the boundaries of the
90;; window. This is primarily used for popup zoom windows. I have
91;; encountered several instances of PostScript programs that position
92;; themselves with respect to the imageable area. The margins are
93;; specified in PostScript points. If omitted, the margins are
94;; assumed to be 0.
95
96(declare-function x-display-mm-width "xfns.c" (&optional terminal))
97(declare-function x-display-pixel-width "xfns.c" (&optional terminal))
98
99(defun gs-width-in-pt (frame pixel-width)
100 "Return, on FRAME, pixel width PIXEL-WIDTH tranlated to pt."
101 (let ((mm (* (float pixel-width)
102 (/ (float (x-display-mm-width frame))
103 (float (x-display-pixel-width frame))))))
104 (/ (* 25.4 mm) 72.0)))
105
106(declare-function x-display-mm-height "xfns.c" (&optional terminal))
107(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
108
109(defun gs-height-in-pt (frame pixel-height)
110 "Return, on FRAME, pixel height PIXEL-HEIGHT tranlated to pt."
111 (let ((mm (* (float pixel-height)
112 (/ (float (x-display-mm-height frame))
113 (float (x-display-pixel-height frame))))))
114 (/ (* 25.4 mm) 72.0)))
115
116(declare-function x-change-window-property "xfns.c"
117 (prop value &optional frame type format outer-p))
118
119(defun gs-set-ghostview-window-prop (frame spec img-width img-height)
120 "Set the `GHOSTVIEW' window property of FRAME.
121SPEC is a GS image specification. IMG-WIDTH is the width of the
122requested image, and IMG-HEIGHT is the height of the requested
123image in pixels."
124 (let* ((box (plist-get (cdr spec) :bounding-box))
125 (llx (elt box 0))
126 (lly (elt box 1))
127 (urx (elt box 2))
128 (ury (elt box 3))
129 (rotation (or (plist-get (cdr spec) :rotate) 0))
130 ;; The pixel width IMG-WIDTH of the pixmap gives the
131 ;; dots, URX - LLX give the inch.
132 (in-width (/ (- urx llx) 72.0))
133 (in-height (/ (- ury lly) 72.0))
134 (xdpi (/ img-width in-width))
135 (ydpi (/ img-height in-height)))
136 (x-change-window-property "GHOSTVIEW"
137 (format "0 %d %d %d %d %d %g %g"
138 rotation llx lly urx ury xdpi ydpi)
139 frame)))
140
141(declare-function x-display-grayscale-p "xfns.c" (&optional terminal))
142
143(defun gs-set-ghostview-colors-window-prop (frame pixel-colors)
144 "Set the `GHOSTVIEW_COLORS' environment variable depending on FRAME."
145 (let ((mode (cond ((x-display-color-p frame) "Color")
146 ((x-display-grayscale-p frame) "Grayscale")
147 (t "Monochrome"))))
148 (x-change-window-property "GHOSTVIEW_COLORS"
149 (format "%s %s" mode pixel-colors)
150 frame)))
151
152(declare-function x-window-property "xfns.c"
153 (prop &optional frame type source delete-p vector-ret-p))
154
155;;;###autoload
156(defun gs-load-image (frame spec img-width img-height window-and-pixmap-id
157 pixel-colors)
158 "Load a PS image for display on FRAME.
159SPEC is an image specification, IMG-HEIGHT and IMG-WIDTH are width
160and height of the image in pixels. WINDOW-AND-PIXMAP-ID is a string of
161the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful."
162 (unwind-protect
163 (let ((file (plist-get (cdr spec) :file))
164 gs
165 (timeout 40))
166 ;; Wait while property gets freed from a previous ghostscript process
167 ;; sit-for returns nil as soon as input starts being
168 ;; available, so if we want to give GhostScript a reasonable
169 ;; chance of starting up, we better use sleep-for. We let
170 ;; sleep-for wait only half the time because if input is
171 ;; available, it is more likely that we don't care that much
172 ;; about garbled redisplay and are in a hurry.
173 (while (and
174 ;; Wait while the property is not yet available
175 (not (zerop (length (x-window-property "GHOSTVIEW"
176 frame))))
177 ;; The following was an alternative condition: wait
178 ;; while there is still a process running. The idea
179 ;; was to avoid contention between processes. Turned
180 ;; out even more sluggish.
181 ;; (get-buffer-process "*GS*")
182 (not (zerop timeout)))
183 (unless (sit-for 0 100 t)
184 (sleep-for 0 50))
185 (setq timeout (1- timeout)))
186
187 ;; No use waiting longer. We might want to try killing off
188 ;; stuck processes, but there is no point in doing so: either
189 ;; they are stuck for good, in which case the user would
190 ;; probably be responsible for that, and killing them off will
191 ;; make debugging harder, or they are not. In that case, they
192 ;; will cause incomplete displays. But the same will happen
193 ;; if they are killed, anyway. The whole is rather
194 ;; disconcerting, and fast scrolling through a dozen images
195 ;; will make Emacs freeze for a while. The alternatives are a)
196 ;; proper implementation not waiting at all but creating
197 ;; appropriate queues, or b) permanently bad display due to
198 ;; bad cached images. So remember that this
199 ;; is just a hack and if people don't like the behavior, they
200 ;; will most likely like the easy alternatives even less.
201 ;; And at least the image cache will make the delay apparent
202 ;; just once.
203 (gs-set-ghostview-window-prop frame spec img-width img-height)
204 (gs-set-ghostview-colors-window-prop frame pixel-colors)
205 (setenv "GHOSTVIEW" window-and-pixmap-id)
206 (setq gs (apply 'start-process "gs" "*GS*" gs-program
207 (gs-options gs-device file)))
208 (set-process-query-on-exit-flag gs nil)
209 gs)
210 nil))
211
212
213;(defun gs-put-tiger ()
214; (let* ((ps-file "/usr/local/share/ghostscript/5.10/examples/tiger.ps")
215; (spec `(image :type postscript
216; :pt-width 200 :pt-height 200
217; :bounding-box (22 171 567 738)
218; :file ,ps-file)))
219; (put-text-property 1 2 'display spec)))
220;
221
222(provide 'gs)
223
224;; arch-tag: 06ab51b8-4932-4cfe-9f60-b924a8edb3f0
225;;; gs.el ends here
diff --git a/lisp/server.el b/lisp/server.el
index 6dc84be0e76..69137c6a60e 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -615,6 +615,8 @@ Server mode runs a process that accepts commands from the
615 615
616(defun server-create-tty-frame (tty type proc) 616(defun server-create-tty-frame (tty type proc)
617 (add-to-list 'frame-inherited-parameters 'client) 617 (add-to-list 'frame-inherited-parameters 'client)
618 (unless tty (error "Invalid terminal device"))
619 (unless type (error "Invalid terminal type"))
618 (let ((frame 620 (let ((frame
619 (server-with-environment (process-get proc 'env) 621 (server-with-environment (process-get proc 'env)
620 '("LANG" "LC_CTYPE" "LC_ALL" 622 '("LANG" "LC_CTYPE" "LC_ALL"
@@ -625,22 +627,24 @@ Server mode runs a process that accepts commands from the
625 "TERMINFO_DIRS" "TERMPATH" 627 "TERMINFO_DIRS" "TERMPATH"
626 ;; rxvt wants these 628 ;; rxvt wants these
627 "COLORFGBG" "COLORTERM") 629 "COLORFGBG" "COLORTERM")
628 (make-frame-on-tty tty type 630 (let ((ws (if (eq window-system 'pc) 'pc nil))
629 ;; Ignore nowait here; we always need to 631 ;; Ignore nowait here; we always need to clean up
630 ;; clean up opened ttys when the client dies. 632 ;; opened ttys when the client dies.
631 `((client . ,proc) 633 (parameters `((client . ,proc)
632 ;; This is a leftover from an earlier 634 ;; This is left over from an earlier
633 ;; attempt at making it possible for process 635 ;; attempt at causing a process run in
634 ;; run in the server process to use the 636 ;; the server process to use the
635 ;; environment of the client process. 637 ;; environment of the client process.
636 ;; It has no effect now and to make it work 638 ;; It has no effect now and to make it
637 ;; we'd need to decide how to make 639 ;; work we'd need to decide how to make
638 ;; process-environment interact with client 640 ;; process-environment interact with
639 ;; envvars, and then to change the 641 ;; client envvars, and then to change
640 ;; C functions `child_setup' and 642 ;; the C functions `child_setup' and
641 ;; `getenv_internal' accordingly. 643 ;; `getenv_internal' accordingly.
642 (environment . ,(process-get proc 'env))))))) 644 (environment . ,(process-get proc 'env)))))
643 645 (make-frame `((window-system . ,ws)
646 (tty . ,tty)
647 (tty-type . ,type) . ,parameters))))))
644 ;; ttys don't use the `display' parameter, but callproc.c does to set 648 ;; ttys don't use the `display' parameter, but callproc.c does to set
645 ;; the DISPLAY environment on subprocesses. 649 ;; the DISPLAY environment on subprocesses.
646 (set-frame-parameter frame 'display 650 (set-frame-parameter frame 'display