Mercurial > emacs
annotate lisp/gs.el @ 53879:e3771c262410
New file. Move original fringe related declarations
and code from dispextern.h and xdisp.c here.
Rework code to support user defined fringe bitmaps, redefining
standard bitmaps, ability to overlay user defined bitmap with
overlay arrow bitmap, and add faces to bitmaps.
(Voverflow_newline_into_fringe): Declare here.
(enum fringe_bitmap_align): New enum.
(..._bits): All bitmaps are now defined without bitswapping; that
is now done in init_fringe_once (if necessary).
(standard_bitmaps): New array with specifications for the
standard fringe bitmaps.
(fringe_faces): New array.
(valid_fringe_bitmap_id_p): New function.
(draw_fringe_bitmap_1): Rename from draw_fringe_bitmap.
(draw_fringe_bitmap): New function which draws fringe bitmap,
possibly overlaying bitmap with cursor in right fringe or the
overlay arrow in the left fringe.
(update_window_fringes): Do not handle overlay arrow here.
Compare and copy fringe bitmap faces.
(init_fringe_bitmap): New function.
(Fdefine_fringe_bitmap, Fdestroy_fringe_bitmap): New DEFUNs to
define and destroy user defined fringe bitmaps.
(Fset_fringe_bitmap_face): New DEFUN to set face for a fringe bitmap.
(Ffringe_bitmaps_at_pos): New DEFUN to read current fringe bitmaps.
(syms_of_fringe): New function. Defsubr new DEFUNs.
DEFVAR_LISP Voverflow_newline_into_fringe.
(init_fringe_once, init_fringe): New functions.
(w32_init_fringe, w32_reset_fringes) [WINDOWS_NT]: New functions.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Sun, 08 Feb 2004 23:18:16 +0000 |
parents | 695cf19ef79e |
children | 00841464e6d8 375f2633d815 |
rev | line source |
---|---|
25003 | 1 ;;; gs.el --- interface to Ghostscript |
2 | |
39313
d7d03c5c76d7
(gs-set-ghostview-window-prop): Use `elt' instead
Gerd Moellmann <gerd@gnu.org>
parents:
38997
diff
changeset
|
3 ;; Copyright (C) 1998, 2001 Free Software Foundation, Inc. |
25003 | 4 |
5 ;; Maintainer: FSF | |
6 ;; Keywords: internal | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 ;; Boston, MA 02111-1307, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; This code is experimental. Don't use it. | |
28 | |
29 ;;; Code: | |
30 | |
31 (defvar gs-program "gs" | |
32 "The name of the Ghostscript interpreter.") | |
33 | |
34 | |
35 (defvar gs-device "x11" | |
36 "The Ghostscript device to use to produce images.") | |
37 | |
38 | |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
39 (defvar gs-options |
25003 | 40 '("-q" |
41 ;"-dNOPAUSE" | |
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 | |
49 (defun gs-options (device file) | |
50 "Return a list of command line options with place-holders replaced. | |
51 DEVICE is the value to substitute for the place-holder `<device>', | |
52 FILE is the value to substitute for the place-holder `<file>'." | |
53 (mapcar #'(lambda (option) | |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
54 (setq option (replace-regexp-in-string "<device>" device option) |
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
55 option (replace-regexp-in-string "<file>" file option))) |
25003 | 56 gs-options)) |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
57 |
25003 | 58 |
59 ;; The GHOSTVIEW property (taken from gv 3.5.8). | |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
60 ;; |
25003 | 61 ;; Type: |
62 ;; | |
63 ;; STRING | |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
64 ;; |
25003 | 65 ;; Parameters: |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
66 ;; |
25003 | 67 ;; BPIXMAP ORIENT LLX LLY URX URY XDPI YDPI [LEFT BOTTOM TOP RIGHT] |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
68 ;; |
25003 | 69 ;; Scanf format: "%d %d %d %d %d %d %f %f %d %d %d %d" |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
70 ;; |
25003 | 71 ;; Explanation of parameters: |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
72 ;; |
25003 | 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. | |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
76 ;; |
25003 | 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. | |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
80 ;; |
25003 | 81 ;; LLX, LLY, URX, URY: Bounding box of the drawable. The bounding box |
82 ;; is specified in PostScript points in default user coordinates. | |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
83 ;; |
25003 | 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.) | |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
87 ;; |
25003 | 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 (defun gs-width-in-pt (frame pixel-width) | |
97 "Return, on FRAME, pixel width PIXEL-WIDTH tranlated to pt." | |
98 (let ((mm (* (float pixel-width) | |
99 (/ (float (x-display-mm-width frame)) | |
100 (float (x-display-pixel-width frame)))))) | |
101 (/ (* 25.4 mm) 72.0))) | |
102 | |
103 | |
104 (defun gs-height-in-pt (frame pixel-height) | |
105 "Return, on FRAME, pixel height PIXEL-HEIGHT tranlated to pt." | |
106 (let ((mm (* (float pixel-height) | |
107 (/ (float (x-display-mm-height frame)) | |
108 (float (x-display-pixel-height frame)))))) | |
109 (/ (* 25.4 mm) 72.0))) | |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
110 |
25003 | 111 |
112 (defun gs-set-ghostview-window-prop (frame spec img-width img-height) | |
113 "Set the `GHOSTVIEW' window property of FRAME. | |
114 SPEC is a GS image specification. IMG-WIDTH is the width of the | |
115 requested image, and IMG-HEIGHT is the height of the requested | |
116 image in pixels." | |
117 (let* ((box (plist-get (cdr spec) :bounding-box)) | |
39518
db80e2ff68e8
(gs-set-ghostview-window-prop): Fix args of `elt'.
Gerd Moellmann <gerd@gnu.org>
parents:
39313
diff
changeset
|
118 (llx (elt box 0)) |
db80e2ff68e8
(gs-set-ghostview-window-prop): Fix args of `elt'.
Gerd Moellmann <gerd@gnu.org>
parents:
39313
diff
changeset
|
119 (lly (elt box 1)) |
db80e2ff68e8
(gs-set-ghostview-window-prop): Fix args of `elt'.
Gerd Moellmann <gerd@gnu.org>
parents:
39313
diff
changeset
|
120 (urx (elt box 2)) |
db80e2ff68e8
(gs-set-ghostview-window-prop): Fix args of `elt'.
Gerd Moellmann <gerd@gnu.org>
parents:
39313
diff
changeset
|
121 (ury (elt box 3)) |
25003 | 122 (rotation (or (plist-get (cdr spec) :rotate) 0)) |
123 ;; The pixel width IMG-WIDTH of the pixmap gives the | |
124 ;; dots, URX - LLX give the inch. | |
125 (in-width (/ (- urx llx) 72.0)) | |
126 (in-height (/ (- ury lly) 72.0)) | |
127 (xdpi (/ img-width in-width)) | |
128 (ydpi (/ img-height in-height))) | |
129 (x-change-window-property "GHOSTVIEW" | |
130 (format "0 %d %d %d %d %d %g %g" | |
131 rotation llx lly urx ury xdpi ydpi) | |
132 frame))) | |
133 | |
134 | |
135 (defun gs-set-ghostview-colors-window-prop (frame pixel-colors) | |
136 "Set the `GHOSTVIEW_COLORS' environment variable depending on FRAME." | |
137 (let ((mode (cond ((x-display-color-p frame) "Color") | |
138 ((x-display-grayscale-p frame) "Grayscale") | |
139 (t "Monochrome")))) | |
140 (x-change-window-property "GHOSTVIEW_COLORS" | |
38890
a6653fe3cbb9
(gs-set-ghostview-colors-window-prop): Call
Gerd Moellmann <gerd@gnu.org>
parents:
38412
diff
changeset
|
141 (format "%s %s" mode pixel-colors) |
a6653fe3cbb9
(gs-set-ghostview-colors-window-prop): Call
Gerd Moellmann <gerd@gnu.org>
parents:
38412
diff
changeset
|
142 frame))) |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
143 |
25003 | 144 |
145 ; | |
146 ;;;###autoload | |
147 (defun gs-load-image (frame spec img-width img-height window-and-pixmap-id | |
148 pixel-colors) | |
149 "Load a PS image for display on FRAME. | |
150 SPEC is an image specification, IMG-HEIGHT and IMG-WIDTH are width | |
151 and height of the image in pixels. WINDOW-AND-PIXMAP-ID is a string of | |
152 the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful." | |
153 (unwind-protect | |
154 (let ((file (plist-get (cdr spec) :file)) | |
38890
a6653fe3cbb9
(gs-set-ghostview-colors-window-prop): Call
Gerd Moellmann <gerd@gnu.org>
parents:
38412
diff
changeset
|
155 gs |
38997
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
156 (timeout 40)) |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
157 ;; Wait while property gets freed from a previous ghostscript process |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
158 ;; sit-for returns nil as soon as input starts being |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
159 ;; available, so if we want to give GhostScript a reasonable |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
160 ;; chance of starting up, we better use sleep-for. We let |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
161 ;; sleep-for wait only half the time because if input is |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
162 ;; available, it is more likely that we don't care that much |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
163 ;; about garbled redisplay and are in a hurry. |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
164 (while (and |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
165 ;; Wait while the property is not yet available |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
166 (not (zerop (length (x-window-property "GHOSTVIEW" |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
167 frame)))) |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
168 ;; The following was an alternative condition: wait |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
169 ;; while there is still a process running. The idea |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
170 ;; was to avoid contention between processes. Turned |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
171 ;; out even more sluggish. |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
172 ;; (get-buffer-process "*GS*") |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
173 (not (zerop timeout))) |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
174 (unless (sit-for 0 100 t) |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
175 (sleep-for 0 50)) |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
176 (setq timeout (1- timeout))) |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
177 |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
178 ;; No use waiting longer. We might want to try killing off |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
179 ;; stuck processes, but there is no point in doing so: either |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
180 ;; they are stuck for good, in which case the user would |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
181 ;; probably be responsible for that, and killing them off will |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
182 ;; make debugging harder, or they are not. In that case, they |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
183 ;; will cause incomplete displays. But the same will happen |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
184 ;; if they are killed, anyway. The whole is rather |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
185 ;; disconcerting, and fast scrolling through a dozen images |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
186 ;; will make Emacs freeze for a while. The alternatives are a) |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
187 ;; proper implementation not waiting at all but creating |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
188 ;; appropriate queues, or b) permanently bad display due to |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
189 ;; bad cached images. So remember that this |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
190 ;; is just a hack and if people don't like the behaviour, they |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
191 ;; will most likely like the easy alternatives even less. |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
192 ;; And at least the image cache will make the delay apparent |
751bf57c84a1
(gs-load-image): Use sleep-for.
Gerd Moellmann <gerd@gnu.org>
parents:
38935
diff
changeset
|
193 ;; just once. |
25003 | 194 (gs-set-ghostview-window-prop frame spec img-width img-height) |
195 (gs-set-ghostview-colors-window-prop frame pixel-colors) | |
196 (setenv "GHOSTVIEW" window-and-pixmap-id) | |
197 (setq gs (apply 'start-process "gs" "*GS*" gs-program | |
198 (gs-options gs-device file))) | |
199 (process-kill-without-query gs) | |
200 gs) | |
201 nil)) | |
202 | |
203 | |
204 ;(defun gs-put-tiger () | |
205 ; (let* ((ps-file "/usr/local/share/ghostscript/5.10/examples/tiger.ps") | |
25651
e65a0e39a0a9
Change `ghostscript' to `postscript' in comment.
Gerd Moellmann <gerd@gnu.org>
parents:
25003
diff
changeset
|
206 ; (spec `(image :type postscript |
25003 | 207 ; :pt-width 200 :pt-height 200 |
208 ; :bounding-box (22 171 567 738) | |
209 ; :file ,ps-file))) | |
210 ; (put-text-property 1 2 'display spec))) | |
35522
9c7789e8882b
use replace-regexps-in-string instead of dired- and gs-replace-in-string
Sam Steingold <sds@gnu.org>
parents:
25651
diff
changeset
|
211 ; |
25003 | 212 |
213 (provide 'gs) | |
214 | |
52401 | 215 ;;; arch-tag: 06ab51b8-4932-4cfe-9f60-b924a8edb3f0 |
38412
253f761ad37b
Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents:
35522
diff
changeset
|
216 ;;; gs.el ends here |