diff options
| author | Chong Yidong | 2009-01-10 13:04:37 +0000 |
|---|---|---|
| committer | Chong Yidong | 2009-01-10 13:04:37 +0000 |
| commit | 6c1ec5a0505cce365e272bce948258b276b29142 (patch) | |
| tree | 815273c44e4452785d618af626c3bb6fa5b7b0b8 | |
| parent | 53ed745ab7978c8ece696a78807cbdda72fc5dd2 (diff) | |
| download | emacs-6c1ec5a0505cce365e272bce948258b276b29142.tar.gz emacs-6c1ec5a0505cce365e272bce948258b276b29142.zip | |
* gs.el: File removed.
| -rw-r--r-- | lisp/ChangeLog | 2 | ||||
| -rw-r--r-- | lisp/frame.el | 17 | ||||
| -rw-r--r-- | lisp/gs.el | 225 | ||||
| -rw-r--r-- | lisp/server.el | 36 |
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 @@ | |||
| 1 | 2009-01-10 Chong Yidong <cyd@stupidchicken.com> | 1 | 2009-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 | ||
| 5 | 2009-01-10 Eli Zaretskii <eliz@gnu.org> | 7 | 2009-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. | ||
| 653 | TTY should be the file name of the tty device to use. TYPE | ||
| 654 | should be the terminal type string of TTY, for example \"xterm\" | ||
| 655 | or \"vt100\". The optional third argument PARAMETERS specifies | ||
| 656 | additional 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. | ||
| 46 | Arguments may contain place-holders `<file>' for the name of the | ||
| 47 | input 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. | ||
| 52 | DEVICE is the value to substitute for the place-holder `<device>', | ||
| 53 | FILE 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. | ||
| 121 | SPEC is a GS image specification. IMG-WIDTH is the width of the | ||
| 122 | requested image, and IMG-HEIGHT is the height of the requested | ||
| 123 | image 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. | ||
| 159 | SPEC is an image specification, IMG-HEIGHT and IMG-WIDTH are width | ||
| 160 | and height of the image in pixels. WINDOW-AND-PIXMAP-ID is a string of | ||
| 161 | the 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 |