Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; ps-mode.el --- PostScript mode for GNU Emacs |
99485bca | 2 | |
114f9c96 | 3 | ;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
034babe1 | 4 | ;; Free Software Foundation, Inc. |
99485bca | 5 | |
e7c2398a EZ |
6 | ;; Author: Peter Kleiweg <p.c.j.kleiweg@rug.nl> |
7 | ;; Maintainer: Peter Kleiweg <p.c.j.kleiweg@rug.nl> | |
99485bca | 8 | ;; Created: 20 Aug 1997 |
e7c2398a | 9 | ;; Version: 1.1h, 16 Jun 2005 |
99485bca GM |
10 | ;; Keywords: PostScript, languages |
11 | ||
241760a3 SM |
12 | ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this |
13 | ;; file on 18/3/2008, and the maintainer agreed that when a bug is | |
14 | ;; filed in the Emacs bug reporting system against this file, a copy | |
15 | ;; of the bug report be sent to the maintainer's email address, but | |
16 | ;; only if: "... those e-mails have a link to the bug report system, | |
17 | ;; where I can cancel these e-mails if I want to.". | |
18 | ||
99485bca GM |
19 | ;; This file is part of GNU Emacs. |
20 | ||
b1fc2b50 | 21 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
99485bca | 22 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
23 | ;; the Free Software Foundation, either version 3 of the License, or |
24 | ;; (at your option) any later version. | |
99485bca GM |
25 | |
26 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
27 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
28 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
29 | ;; GNU General Public License for more details. | |
30 | ||
31 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 32 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
99485bca GM |
33 | |
34 | ;;; Commentary: | |
35 | ||
36 | \f | |
37 | ;;; Code: | |
38 | ||
e7c2398a EZ |
39 | (defconst ps-mode-version "1.1h, 16 Jun 2005") |
40 | (defconst ps-mode-maintainer-address "Peter Kleiweg <p.c.j.kleiweg@rug.nl>") | |
c22d928f | 41 | |
9cf2db99 | 42 | (require 'comint) |
99485bca GM |
43 | (require 'easymenu) |
44 | ||
45 | ;; Define core `PostScript' group. | |
46 | (defgroup PostScript nil | |
47 | "PostScript mode for Emacs." | |
48 | :group 'languages) | |
49 | ||
50 | (defgroup PostScript-edit nil | |
51 | "PostScript editing." | |
8ec3bce0 | 52 | :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) |
99485bca GM |
53 | :prefix "ps-mode-" |
54 | :group 'PostScript) | |
55 | ||
56 | (defgroup PostScript-interaction nil | |
57 | "PostScript interaction." | |
58 | :prefix "ps-run-" | |
59 | :group 'PostScript) | |
60 | ||
61 | ;; User variables. | |
62 | ||
63 | (defcustom ps-mode-auto-indent t | |
64 | "*Should we use autoindent?" | |
65 | :group 'PostScript-edit | |
66 | :type 'boolean) | |
67 | ||
68 | (defcustom ps-mode-tab 4 | |
69 | "*Number of spaces to use when indenting." | |
70 | :group 'PostScript-edit | |
71 | :type 'integer) | |
72 | ||
73 | (defcustom ps-mode-paper-size '(595 842) | |
74 | "*Default paper size. | |
75 | ||
76 | When inserting an EPSF template these values are used | |
77 | to set the boundingbox to include the whole page. | |
78 | When the figure is finished these values should be replaced." | |
79 | :group 'PostScript-edit | |
80 | :type '(choice | |
81 | (const :tag "letter" (612 792)) | |
82 | (const :tag "legal" (612 1008)) | |
83 | (const :tag "a0" (2380 3368)) | |
84 | (const :tag "a1" (1684 2380)) | |
85 | (const :tag "a2" (1190 1684)) | |
86 | (const :tag "a3" (842 1190)) | |
87 | (const :tag "a4" (595 842)) | |
88 | (const :tag "a5" (421 595)) | |
89 | (const :tag "a6" (297 421)) | |
90 | (const :tag "a7" (210 297)) | |
91 | (const :tag "a8" (148 210)) | |
92 | (const :tag "a9" (105 148)) | |
93 | (const :tag "a10" (74 105)) | |
94 | (const :tag "b0" (2836 4008)) | |
95 | (const :tag "b1" (2004 2836)) | |
96 | (const :tag "b2" (1418 2004)) | |
97 | (const :tag "b3" (1002 1418)) | |
98 | (const :tag "b4" (709 1002)) | |
99 | (const :tag "b5" (501 709)) | |
100 | (const :tag "archE" (2592 3456)) | |
101 | (const :tag "archD" (1728 2592)) | |
102 | (const :tag "archC" (1296 1728)) | |
103 | (const :tag "archB" (864 1296)) | |
104 | (const :tag "archA" (648 864)) | |
105 | (const :tag "flsa" (612 936)) | |
106 | (const :tag "flse" (612 936)) | |
107 | (const :tag "halfletter" (396 612)) | |
108 | (const :tag "11x17" (792 1224)) | |
109 | (const :tag "tabloid" (792 1224)) | |
110 | (const :tag "ledger" (1224 792)) | |
111 | (const :tag "csheet" (1224 1584)) | |
112 | (const :tag "dsheet" (1584 2448)) | |
113 | (const :tag "esheet" (2448 3168)))) | |
114 | ||
627a4e30 GM |
115 | (defcustom ps-mode-print-function |
116 | (lambda () | |
c22d928f | 117 | (let ((lpr-switches nil) |
f3041af1 | 118 | (lpr-command (if (memq system-type '(usg-unix-v hpux irix)) |
155fc930 | 119 | "lp" "lpr"))) |
c22d928f | 120 | (lpr-buffer))) |
99485bca GM |
121 | "*Lisp function to print current buffer as PostScript." |
122 | :group 'PostScript-edit | |
123 | :type 'function) | |
124 | ||
125 | (defcustom ps-run-prompt "\\(GS\\(<[0-9]+\\)?>\\)+" | |
126 | "*Regexp to match prompt in interactive PostScript." | |
127 | :group 'PostScript-interaction | |
128 | :type 'regexp) | |
129 | ||
c22d928f GM |
130 | (defcustom ps-run-font-lock-keywords-2 |
131 | (append (unless (string= ps-run-prompt "") | |
132 | (list (list (if (= ?^ (string-to-char ps-run-prompt)) | |
133 | ps-run-prompt | |
134 | (concat "^" ps-run-prompt)) | |
135 | '(0 font-lock-function-name-face nil nil)))) | |
136 | '((">>showpage, press <return> to continue<<" | |
137 | (0 font-lock-keyword-face nil nil)) | |
138 | ("^\\(Error\\|Can't\\).*" | |
139 | (0 font-lock-warning-face nil nil)) | |
627a4e30 | 140 | ("^\\(Current file position is\\) \\([0-9]+\\)" |
c22d928f GM |
141 | (1 font-lock-comment-face nil nil) |
142 | (2 font-lock-warning-face nil nil)))) | |
99485bca GM |
143 | "*Medium level highlighting of messages from the PostScript interpreter. |
144 | ||
145 | See documentation on font-lock for details." | |
146 | :group 'PostScript-interaction | |
147 | :type '(repeat (list :tag "Expression with one or more highlighters" | |
148 | :value ("" (0 default nil t)) | |
149 | (regexp :tag "Expression") | |
150 | (repeat :tag "Highlighters" | |
151 | :inline regexp | |
152 | (list :tag "Highlighter" | |
153 | (integer :tag "Subexp") | |
154 | face | |
155 | (boolean :tag "Override") | |
156 | (boolean :tag "Laxmatch" :value t)))))) | |
157 | ||
158 | (defcustom ps-run-x '("gs" "-r72" "-sPAPERSIZE=a4") | |
159 | "*Command as list to run PostScript with graphic display." | |
160 | :group 'PostScript-interaction | |
161 | :type '(repeat string)) | |
162 | ||
163 | (defcustom ps-run-dumb '("gs" "-dNODISPLAY") | |
164 | "*Command as list to run PostScript without graphic display." | |
165 | :group 'PostScript-interaction | |
166 | :type '(repeat string)) | |
167 | ||
168 | (defcustom ps-run-init nil | |
169 | "*String of commands to send to PostScript to start interactive. | |
170 | ||
c22d928f | 171 | Example: \"executive\" |
99485bca | 172 | |
627a4e30 | 173 | You won't need to set this option for Ghostscript." |
99485bca GM |
174 | :group 'PostScript-interaction |
175 | :type '(choice (const nil) string)) | |
176 | ||
177 | (defcustom ps-run-error-line-numbers nil | |
178 | "*What values are used by the PostScript interpreter in error messages?" | |
179 | :group 'PostScript-interaction | |
180 | :type '(choice (const :tag "line numbers" t) | |
181 | (const :tag "byte counts" nil))) | |
182 | ||
183 | (defcustom ps-run-tmp-dir nil | |
184 | "*Name of directory to place temporary file. | |
fa8c4a38 | 185 | If nil, use `temporary-file-directory'." |
99485bca GM |
186 | :group 'PostScript-interaction |
187 | :type '(choice (const nil) directory)) | |
188 | ||
189 | \f | |
190 | ;; Constants used for font-lock. | |
191 | ||
192 | ;; Only a small set of the PostScript operators is selected for fontification. | |
193 | ;; Fontification is meant to clarify the document structure and process flow, | |
194 | ;; fontifying all known PostScript operators would hinder that objective. | |
195 | (defconst ps-mode-operators | |
196 | (let ((ops '("clear" "mark" "cleartomark" "counttomark" | |
197 | "forall" | |
198 | "dict" "begin" "end" "def" | |
199 | "true" "false" | |
200 | "exec" "if" "ifelse" "for" "repeat" "loop" "exit" | |
201 | "stop" "stopped" "countexecstack" "execstack" | |
202 | "quit" "start" | |
203 | "save" "restore" | |
204 | "bind" "null" | |
205 | "gsave" "grestore" "grestoreall" | |
206 | "showpage"))) | |
207 | (concat "\\<" (regexp-opt ops t) "\\>")) | |
627a4e30 | 208 | "Regexp of PostScript operators that will be fontified.") |
99485bca GM |
209 | |
210 | ;; Level 1 font-lock: | |
211 | ;; - Special comments (reference face) | |
212 | ;; - Strings and other comments | |
213 | ;; - Partial strings (warning face) | |
214 | ;; - 8bit characters (warning face) | |
215 | ;; Multiline strings are not supported. Strings with nested brackets are. | |
216 | (defconst ps-mode-font-lock-keywords-1 | |
217 | '(("\\`%!PS.*" . font-lock-reference-face) | |
627a4e30 | 218 | ("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$" |
99485bca GM |
219 | . font-lock-reference-face) |
220 | (ps-mode-match-string-or-comment | |
221 | (1 font-lock-comment-face nil t) | |
222 | (2 font-lock-string-face nil t)) | |
223 | ("([^()\n%]*\\|[^()\n]*)" . font-lock-warning-face) | |
224 | ("[\200-\377]+" (0 font-lock-warning-face prepend nil))) | |
225 | "Subdued level highlighting for PostScript mode.") | |
226 | ||
227 | ;; Level 2 font-lock: | |
228 | ;; - All from level 1 | |
229 | ;; - PostScript operators (keyword face) | |
230 | (defconst ps-mode-font-lock-keywords-2 | |
231 | (append | |
232 | ps-mode-font-lock-keywords-1 | |
233 | (list | |
234 | (cons | |
235 | ;; exclude names prepended by `/' | |
236 | (concat "\\(^\\|[^/\n]\\)" ps-mode-operators) | |
237 | '(2 font-lock-keyword-face)))) | |
238 | "Medium level highlighting for PostScript mode.") | |
239 | ||
240 | ;; Level 3 font-lock: | |
241 | ;; - All from level 2 | |
242 | ;; - Immediately evaluated names: those starting with `//' (type face) | |
243 | ;; - Names that look like they are used for the definition of: | |
244 | ;; * a function | |
245 | ;; * an array | |
246 | ;; * a dictionary | |
247 | ;; * a "global" variable | |
248 | ;; (function name face) | |
249 | ;; - Other names (variable name face) | |
250 | ;; The rules used to determine what names fit in the first category are: | |
251 | ;; - Only names that are at the left margin, and one of these on the same line: | |
252 | ;; * Nothing after the name except possibly one or more `[' or a comment | |
253 | ;; * A `{' or `<<' or `[0-9]+ dict' following the name | |
254 | ;; * A `def' somewhere in the same line | |
255 | ;; Names are fontified before PostScript operators, allowing the use of | |
256 | ;; a more simple (efficient) regexp than the one used in level 2. | |
257 | (defconst ps-mode-font-lock-keywords-3 | |
258 | (append | |
259 | ps-mode-font-lock-keywords-1 | |
260 | (list | |
261 | '("//\\w+" . font-lock-type-face) | |
6114f9e5 RS |
262 | `(,(concat |
263 | "^\\(/\\w+\\)\\>" | |
264 | "\\([[ \t]*\\(%.*\\)?\r?$" ; Nothing but `[' or comment after the name. | |
265 | "\\|[ \t]*\\({\\|<<\\)" ; `{' or `<<' following the name. | |
266 | "\\|[ \t]+[0-9]+[ \t]+dict\\>" ; `[0-9]+ dict' following the name. | |
267 | "\\|.*\\<def\\>\\)") ; `def' somewhere on the same line. | |
99485bca GM |
268 | . (1 font-lock-function-name-face)) |
269 | '("/\\w+" . font-lock-variable-name-face) | |
270 | (cons ps-mode-operators 'font-lock-keyword-face))) | |
271 | "High level highliting for PostScript mode.") | |
272 | ||
273 | (defconst ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1 | |
274 | "Default expressions to highlight in PostScript mode.") | |
275 | ||
276 | ;; Level 1 font-lock for ps-run-mode | |
277 | ;; - prompt (function name face) | |
278 | (defconst ps-run-font-lock-keywords-1 | |
c22d928f GM |
279 | (unless (string= "" ps-run-prompt) |
280 | (list (cons (if (= ?^ (string-to-char ps-run-prompt)) | |
281 | ps-run-prompt | |
282 | (concat "^" ps-run-prompt)) | |
283 | 'font-lock-function-name-face))) | |
99485bca GM |
284 | "Subdued level highlighting for PostScript run mode.") |
285 | ||
286 | (defconst ps-run-font-lock-keywords ps-run-font-lock-keywords-1 | |
287 | "Default expressions to highlight in PostScript run mode.") | |
288 | ||
289 | \f | |
290 | ;; Variables. | |
291 | ||
292 | (defvar ps-mode-map nil | |
293 | "Local keymap to use in PostScript mode.") | |
294 | ||
295 | (defvar ps-mode-syntax-table nil | |
296 | "Syntax table used while in PostScript mode.") | |
297 | ||
298 | (defvar ps-run-mode-map nil | |
299 | "Local keymap to use in PostScript run mode.") | |
300 | ||
301 | (defvar ps-mode-tmp-file nil | |
302 | "Name of temporary file, set by `ps-run'.") | |
303 | ||
304 | (defvar ps-run-mark nil | |
305 | "Mark to start of region that was sent to PostScript interpreter.") | |
306 | ||
307 | (defvar ps-run-parent nil | |
308 | "Parent window of interactive PostScript.") | |
309 | ||
310 | \f | |
311 | ;; Menu | |
312 | ||
313 | (defconst ps-mode-menu-main | |
314 | '("PostScript" | |
315 | ["EPSF Template, Sparse" ps-mode-epsf-sparse t] | |
316 | ["EPSF Template, Rich" ps-mode-epsf-rich t] | |
317 | "---" | |
318 | ("Cookbook" | |
319 | ["RE" ps-mode-RE t] | |
320 | ["ISOLatin1Extended" ps-mode-latin-extended t] | |
321 | ["center" ps-mode-center t] | |
322 | ["right" ps-mode-right t] | |
323 | ["Heapsort" ps-mode-heapsort t]) | |
324 | ("Fonts (1)" | |
325 | ["Times-Roman" (insert "/Times-Roman ") t] | |
326 | ["Times-Bold" (insert "/Times-Bold ") t] | |
327 | ["Times-Italic" (insert "/Times-Italic ") t] | |
328 | ["Times-BoldItalic" (insert "/Times-BoldItalic ") t] | |
329 | ["Helvetica" (insert "/Helvetica ") t] | |
330 | ["Helvetica-Bold" (insert "/Helvetica-Bold ") t] | |
331 | ["Helvetica-Oblique" (insert "/Helvetica-Oblique ") t] | |
332 | ["Helvetica-BoldOblique" (insert "/Helvetica-BoldOblique ") t] | |
333 | ["Courier" (insert "/Courier ") t] | |
334 | ["Courier-Bold" (insert "/Courier-Bold ") t] | |
335 | ["Courier-Oblique" (insert "/Courier-Oblique ") t] | |
336 | ["Courier-BoldOblique" (insert "/Courier-BoldOblique ") t] | |
337 | ["Symbol" (insert "/Symbol") t ]) | |
338 | ("Fonts (2)" | |
339 | ["AvantGarde-Book" (insert "/AvantGarde-Book ") t] | |
340 | ["AvantGarde-Demi" (insert "/AvantGarde-Demi ") t] | |
341 | ["AvantGarde-BookOblique" (insert "/AvantGarde-BookOblique ") t] | |
342 | ["AvantGarde-DemiOblique" (insert "/AvantGarde-DemiOblique ") t] | |
343 | ["Bookman-Light" (insert "/Bookman-Light ") t] | |
344 | ["Bookman-Demi" (insert "/Bookman-Demi ") t] | |
345 | ["Bookman-LightItalic" (insert "/Bookman-LightItalic ") t] | |
346 | ["Bookman-DemiItalic" (insert "/Bookman-DemiItalic ") t] | |
347 | ["Helvetica-Narrow" (insert "/Helvetica-Narrow ") t] | |
348 | ["Helvetica-Narrow-Bold" (insert "/Helvetica-Narrow-Bold ") t] | |
349 | ["Helvetica-Narrow-Oblique" (insert "/Helvetica-Narrow-Oblique ") t] | |
350 | ["Helvetica-Narrow-BoldOblique" (insert "/Helvetica-Narrow-BoldOblique ") t] | |
351 | ["NewCenturySchlbk-Roman" (insert "/NewCenturySchlbk-Roman ") t] | |
352 | ["NewCenturySchlbk-Bold" (insert "/NewCenturySchlbk-Bold ") t] | |
353 | ["NewCenturySchlbk-Italic" (insert "/NewCenturySchlbk-Italic ") t] | |
354 | ["NewCenturySchlbk-BoldItalic" (insert "/NewCenturySchlbk-BoldItalic ") t] | |
355 | ["Palatino-Roman" (insert "/Palatino-Roman ") t] | |
356 | ["Palatino-Bold" (insert "/Palatino-Bold ") t] | |
357 | ["Palatino-Italic" (insert "/Palatino-Italic ") t] | |
358 | ["Palatino-BoldItalic" (insert "/Palatino-BoldItalic ") t] | |
359 | ["ZapfChancery-MediumItalic" (insert "/ZapfChancery-MediumItalic ") t] | |
360 | ["ZapfDingbats" (insert "/ZapfDingbats ") t]) | |
361 | "---" | |
362 | ["Comment Out Region" ps-mode-comment-out-region (mark t)] | |
363 | ["Uncomment Region" ps-mode-uncomment-region (mark t)] | |
364 | "---" | |
365 | ["8-bit to Octal Buffer" ps-mode-octal-buffer t] | |
366 | ["8-bit to Octal Region" ps-mode-octal-region (mark t)] | |
367 | "---" | |
627a4e30 GM |
368 | ["Auto Indent" (setq ps-mode-auto-indent (not ps-mode-auto-indent)) |
369 | :style toggle :selected ps-mode-auto-indent] | |
99485bca GM |
370 | "---" |
371 | ["Start PostScript" | |
372 | ps-run-start | |
373 | t] | |
374 | ["Quit PostScript" ps-run-quit (process-status "ps-run")] | |
375 | ["Kill PostScript" ps-run-kill (process-status "ps-run")] | |
376 | ["Send Buffer to Interpreter" | |
377 | ps-run-buffer | |
378 | (process-status "ps-run")] | |
379 | ["Send Region to Interpreter" | |
380 | ps-run-region | |
381 | (and (mark t) (process-status "ps-run"))] | |
382 | ["Send Newline to Interpreter" | |
383 | ps-mode-other-newline | |
384 | (process-status "ps-run")] | |
385 | ["View BoundingBox" | |
386 | ps-run-boundingbox | |
387 | (process-status "ps-run")] | |
388 | ["Clear/Reset PostScript Graphics" | |
389 | ps-run-clear | |
390 | (process-status "ps-run")] | |
391 | "---" | |
392 | ["Print Buffer as PostScript" | |
393 | ps-mode-print-buffer | |
394 | t] | |
395 | ["Print Region as PostScript" | |
396 | ps-mode-print-region | |
397 | (mark t)] | |
398 | "---" | |
399 | ["Customize for PostScript" | |
400 | (customize-group "PostScript") | |
aebf9ad1 GM |
401 | t] |
402 | "---" | |
403 | ["Submit Bug Report" | |
404 | ps-mode-submit-bug-report | |
99485bca GM |
405 | t])) |
406 | ||
407 | \f | |
408 | ;; Mode maps for PostScript edit mode and PostScript interaction mode. | |
409 | ||
410 | (unless ps-mode-map | |
411 | (setq ps-mode-map (make-sparse-keymap)) | |
99485bca | 412 | (define-key ps-mode-map "\C-c\C-v" 'ps-run-boundingbox) |
c22d928f GM |
413 | (define-key ps-mode-map "\C-c\C-u" 'ps-mode-uncomment-region) |
414 | (define-key ps-mode-map "\C-c\C-t" 'ps-mode-epsf-rich) | |
415 | (define-key ps-mode-map "\C-c\C-s" 'ps-run-start) | |
416 | (define-key ps-mode-map "\C-c\C-r" 'ps-run-region) | |
417 | (define-key ps-mode-map "\C-c\C-q" 'ps-run-quit) | |
418 | (define-key ps-mode-map "\C-c\C-p" 'ps-mode-print-buffer) | |
419 | (define-key ps-mode-map "\C-c\C-o" 'ps-mode-comment-out-region) | |
420 | (define-key ps-mode-map "\C-c\C-k" 'ps-run-kill) | |
421 | (define-key ps-mode-map "\C-c\C-j" 'ps-mode-other-newline) | |
5ca7d652 | 422 | (define-key ps-mode-map "\C-c\C-l" 'ps-run-clear) |
c22d928f GM |
423 | (define-key ps-mode-map "\C-c\C-b" 'ps-run-buffer) |
424 | (define-key ps-mode-map ">" 'ps-mode-r-gt) | |
425 | (define-key ps-mode-map "]" 'ps-mode-r-angle) | |
426 | (define-key ps-mode-map "}" 'ps-mode-r-brace) | |
427 | (define-key ps-mode-map "\177" 'ps-mode-backward-delete-char) | |
428 | (define-key ps-mode-map "\t" 'ps-mode-tabkey) | |
429 | (define-key ps-mode-map "\r" 'ps-mode-newline) | |
430 | (define-key ps-mode-map [return] 'ps-mode-newline) | |
99485bca GM |
431 | (easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main)) |
432 | ||
433 | (unless ps-run-mode-map | |
434 | (setq ps-run-mode-map (make-sparse-keymap)) | |
9cf2db99 | 435 | (set-keymap-parent ps-run-mode-map comint-mode-map) |
99485bca GM |
436 | (define-key ps-run-mode-map "\C-c\C-q" 'ps-run-quit) |
437 | (define-key ps-run-mode-map "\C-c\C-k" 'ps-run-kill) | |
438 | (define-key ps-run-mode-map "\C-c\C-e" 'ps-run-goto-error) | |
9cf2db99 | 439 | (define-key ps-run-mode-map [mouse-2] 'ps-run-mouse-goto-error)) |
99485bca GM |
440 | |
441 | \f | |
442 | ;; Syntax table. | |
443 | ||
444 | (unless ps-mode-syntax-table | |
445 | (setq ps-mode-syntax-table (make-syntax-table)) | |
627a4e30 | 446 | |
99485bca GM |
447 | (modify-syntax-entry ?\% "< " ps-mode-syntax-table) |
448 | (modify-syntax-entry ?\n "> " ps-mode-syntax-table) | |
449 | (modify-syntax-entry ?\r "> " ps-mode-syntax-table) | |
450 | (modify-syntax-entry ?\f "> " ps-mode-syntax-table) | |
451 | (modify-syntax-entry ?\< "(>" ps-mode-syntax-table) | |
452 | (modify-syntax-entry ?\> ")<" ps-mode-syntax-table) | |
627a4e30 | 453 | |
99485bca GM |
454 | (modify-syntax-entry ?\! "w " ps-mode-syntax-table) |
455 | (modify-syntax-entry ?\" "w " ps-mode-syntax-table) | |
456 | (modify-syntax-entry ?\# "w " ps-mode-syntax-table) | |
457 | (modify-syntax-entry ?\$ "w " ps-mode-syntax-table) | |
458 | (modify-syntax-entry ?\& "w " ps-mode-syntax-table) | |
459 | (modify-syntax-entry ?\' "w " ps-mode-syntax-table) | |
460 | (modify-syntax-entry ?\* "w " ps-mode-syntax-table) | |
461 | (modify-syntax-entry ?\+ "w " ps-mode-syntax-table) | |
462 | (modify-syntax-entry ?\, "w " ps-mode-syntax-table) | |
463 | (modify-syntax-entry ?\- "w " ps-mode-syntax-table) | |
464 | (modify-syntax-entry ?\. "w " ps-mode-syntax-table) | |
465 | (modify-syntax-entry ?\: "w " ps-mode-syntax-table) | |
466 | (modify-syntax-entry ?\; "w " ps-mode-syntax-table) | |
467 | (modify-syntax-entry ?\= "w " ps-mode-syntax-table) | |
468 | (modify-syntax-entry ?\? "w " ps-mode-syntax-table) | |
469 | (modify-syntax-entry ?\@ "w " ps-mode-syntax-table) | |
470 | (modify-syntax-entry ?\\ "w " ps-mode-syntax-table) | |
471 | (modify-syntax-entry ?^ "w " ps-mode-syntax-table) ; NOT: ?\^ | |
472 | (modify-syntax-entry ?\_ "w " ps-mode-syntax-table) | |
473 | (modify-syntax-entry ?\` "w " ps-mode-syntax-table) | |
474 | (modify-syntax-entry ?\| "w " ps-mode-syntax-table) | |
475 | (modify-syntax-entry ?\~ "w " ps-mode-syntax-table) | |
627a4e30 | 476 | |
99485bca GM |
477 | (let ((i 128)) |
478 | (while (< i 256) | |
479 | (modify-syntax-entry i "w " ps-mode-syntax-table) | |
480 | (setq i (1+ i))))) | |
481 | ||
482 | \f | |
6d00e226 | 483 | |
5cec3056 | 484 | (declare-function doc-view-minor-mode "doc-view") |
6d00e226 | 485 | |
99485bca GM |
486 | ;; PostScript mode. |
487 | ||
7c3d5ad9 | 488 | ;;;###autoload |
627a4e30 | 489 | (define-derived-mode ps-mode fundamental-mode "PostScript" |
99485bca GM |
490 | "Major mode for editing PostScript with GNU Emacs. |
491 | ||
492 | Entry to this mode calls `ps-mode-hook'. | |
493 | ||
494 | The following variables hold user options, and can | |
495 | be set through the `customize' command: | |
496 | ||
627a4e30 GM |
497 | `ps-mode-auto-indent' |
498 | `ps-mode-tab' | |
499 | `ps-mode-paper-size' | |
500 | `ps-mode-print-function' | |
501 | `ps-run-prompt' | |
502 | `ps-run-font-lock-keywords-2' | |
503 | `ps-run-x' | |
504 | `ps-run-dumb' | |
505 | `ps-run-init' | |
506 | `ps-run-error-line-numbers' | |
507 | `ps-run-tmp-dir' | |
99485bca GM |
508 | |
509 | Type \\[describe-variable] for documentation on these options. | |
510 | ||
511 | ||
512 | \\{ps-mode-map} | |
513 | ||
514 | ||
515 | When starting an interactive PostScript process with \\[ps-run-start], | |
516 | a second window will be displayed, and `ps-run-mode-hook' will be called. | |
517 | The keymap for this second window is: | |
518 | ||
519 | \\{ps-run-mode-map} | |
520 | ||
521 | ||
522 | When Ghostscript encounters an error it displays an error message | |
523 | with a file position. Clicking mouse-2 on this number will bring | |
524 | point to the corresponding spot in the PostScript window, if input | |
525 | to the interpreter was sent from that window. | |
627a4e30 GM |
526 | Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect." |
527 | (set (make-local-variable 'font-lock-defaults) | |
528 | '((ps-mode-font-lock-keywords | |
529 | ps-mode-font-lock-keywords-1 | |
530 | ps-mode-font-lock-keywords-2 | |
531 | ps-mode-font-lock-keywords-3) | |
6114f9e5 RS |
532 | t)) |
533 | (set (make-local-variable 'comment-start) "%") | |
534 | ;; NOTE: `\' has a special meaning in strings only | |
5b549c31 GM |
535 | (set (make-local-variable 'comment-start-skip) "%+[ \t]*") |
536 | ;; enable doc-view-minor-mode => C-c C-c starts viewing the current ps file | |
537 | ;; with doc-view-mode. | |
538 | (doc-view-minor-mode 1)) | |
99485bca | 539 | |
c22d928f | 540 | (defun ps-mode-show-version () |
627a4e30 | 541 | "Show current version of PostScript mode." |
c22d928f GM |
542 | (interactive) |
543 | (message " *** PostScript Mode (ps-mode) Version %s *** " ps-mode-version)) | |
544 | ||
aebf9ad1 | 545 | (defun ps-mode-submit-bug-report () |
627a4e30 | 546 | "Submit via mail a bug report on PostScript mode." |
aebf9ad1 | 547 | (interactive) |
627a4e30 | 548 | (when (y-or-n-p "Submit bug report on PostScript mode? ") |
8f011fdc GM |
549 | (let ((reporter-prompt-for-summary-p nil) |
550 | (reporter-dont-compact-list '(ps-mode-print-function | |
551 | ps-run-font-lock-keywords-2))) | |
aebf9ad1 GM |
552 | (reporter-submit-bug-report |
553 | ps-mode-maintainer-address | |
8f011fdc GM |
554 | (format "ps-mode.el %s [%s]" ps-mode-version system-type) |
555 | '(ps-mode-auto-indent | |
556 | ps-mode-tab | |
557 | ps-mode-paper-size | |
558 | ps-mode-print-function | |
559 | ps-run-prompt | |
560 | ps-run-font-lock-keywords-2 | |
561 | ps-run-x | |
562 | ps-run-dumb | |
563 | ps-run-init | |
564 | ps-run-error-line-numbers | |
565 | ps-run-tmp-dir))))) | |
aebf9ad1 | 566 | |
99485bca GM |
567 | \f |
568 | ;; Helper functions for font-lock. | |
569 | ||
570 | ;; When this function is called, point is at an opening bracket. | |
571 | ;; This function should test if point is at the start of a string | |
572 | ;; with nested brackets. | |
573 | ;; If true: move point to end of string | |
574 | ;; set string to match data nr 2 | |
575 | ;; return new point | |
576 | ;; If false: return nil | |
577 | (defun ps-mode-looking-at-nested (limit) | |
578 | (let ((first (point)) | |
579 | (level 1) | |
580 | pos) | |
581 | ;; Move past opening bracket. | |
582 | (forward-char 1) | |
583 | (setq pos (point)) | |
584 | (while (and (> level 0) (< pos limit)) | |
585 | ;; Search next bracket, stepping over escaped brackets. | |
586 | (if (not (looking-at "\\([^()\\\n]\\|\\\\.\\)*\\([()]\\)")) | |
587 | (setq level -1) | |
6114f9e5 RS |
588 | (setq level (+ level (if (string= "(" (match-string 2)) 1 -1))) |
589 | (goto-char (setq pos (match-end 0))))) | |
99485bca GM |
590 | (if (not (= level 0)) |
591 | nil | |
592 | ;; Found string with nested brackets, now set match data nr 2. | |
6114f9e5 RS |
593 | (set-match-data (list first pos nil nil first pos)) |
594 | pos))) | |
99485bca GM |
595 | |
596 | ;; This function should search for a string or comment | |
597 | ;; If comment, return as match data nr 1 | |
598 | ;; If string, return as match data nr 2 | |
599 | (defun ps-mode-match-string-or-comment (limit) | |
600 | ;; Find the first potential match. | |
601 | (if (not (re-search-forward "[%(]" limit t)) | |
602 | ;; Nothing found: return failure. | |
603 | nil | |
627a4e30 | 604 | (let ((end (match-end 0))) |
99485bca | 605 | (goto-char (match-beginning 0)) |
99485bca GM |
606 | (cond ((looking-at "\\(%.*\\)\\|\\((\\([^()\\\n]\\|\\\\.\\)*)\\)") |
607 | ;; It's a comment or string without nested, unescaped brackets. | |
608 | (goto-char (match-end 0)) | |
609 | (point)) | |
610 | ((ps-mode-looking-at-nested limit) | |
611 | ;; It's a string with nested brackets. | |
612 | (point)) | |
613 | (t | |
627a4e30 | 614 | ;; Try next match. |
99485bca GM |
615 | (goto-char end) |
616 | (ps-mode-match-string-or-comment limit)))))) | |
617 | ||
618 | \f | |
619 | ;; Key-handlers. | |
620 | ||
621 | (defun ps-mode-target-column () | |
622 | "To what column should text on current line be indented? | |
623 | ||
624 | Identation is increased if the last token on the current line | |
625 | defines the beginning of a group. These tokens are: { [ <<" | |
626 | (save-excursion | |
627 | (beginning-of-line) | |
628 | (if (looking-at "[ \t]*\\(}\\|\\]\\|>>\\)") | |
629 | (condition-case err | |
630 | (progn | |
631 | (goto-char (match-end 0)) | |
632 | (backward-sexp 1) | |
633 | (beginning-of-line) | |
634 | (if (looking-at "[ \t]+") | |
635 | (goto-char (match-end 0))) | |
636 | (current-column)) | |
637 | (error | |
638 | (ding) | |
29a4e67d | 639 | (message "%s" (error-message-string err)) |
99485bca GM |
640 | 0)) |
641 | (let (target) | |
642 | (if (not (re-search-backward "[^ \t\n\r\f][ \t\n\r\f]*\\=" nil t)) | |
643 | 0 | |
644 | (goto-char (match-beginning 0)) | |
645 | (beginning-of-line) | |
646 | (if (looking-at "[ \t]+") | |
647 | (goto-char (match-end 0))) | |
648 | (setq target (current-column)) | |
649 | (end-of-line) | |
650 | (if (re-search-backward "\\({\\|\\[\\|<<\\)[ \t]*\\(%[^\n]*\\)?\\=" nil t) | |
651 | (setq target (+ target ps-mode-tab))) | |
652 | target))))) | |
653 | ||
654 | (defun ps-mode-newline () | |
655 | "Insert newline with proper indentation." | |
656 | (interactive) | |
657 | (delete-horizontal-space) | |
658 | (insert "\n") | |
659 | (if ps-mode-auto-indent | |
660 | (indent-to (ps-mode-target-column)))) | |
661 | ||
662 | (defun ps-mode-tabkey () | |
627a4e30 | 663 | "Indent/reindent current line, or insert tab." |
99485bca GM |
664 | (interactive) |
665 | (let ((column (current-column)) | |
666 | target) | |
667 | (if (or (not ps-mode-auto-indent) | |
668 | (< ps-mode-tab 1) | |
669 | (not (re-search-backward "^[ \t]*\\=" nil t))) | |
670 | (insert "\t") | |
671 | (setq target (ps-mode-target-column)) | |
672 | (while (<= target column) | |
673 | (setq target (+ target ps-mode-tab))) | |
627a4e30 | 674 | (indent-line-to target)))) |
99485bca GM |
675 | |
676 | (defun ps-mode-backward-delete-char () | |
627a4e30 | 677 | "Delete backward indentation, or delete backward character." |
99485bca GM |
678 | (interactive) |
679 | (let ((column (current-column)) | |
680 | target) | |
681 | (if (or (not ps-mode-auto-indent) | |
682 | (< ps-mode-tab 1) | |
683 | (not (re-search-backward "^[ \t]+\\=" nil t))) | |
d355a0b7 | 684 | (call-interactively 'delete-backward-char) |
99485bca GM |
685 | (setq target (ps-mode-target-column)) |
686 | (while (> column target) | |
687 | (setq target (+ target ps-mode-tab))) | |
688 | (while (>= target column) | |
689 | (setq target (- target ps-mode-tab))) | |
690 | (if (< target 0) | |
691 | (setq target 0)) | |
627a4e30 | 692 | (indent-line-to target)))) |
99485bca GM |
693 | |
694 | (defun ps-mode-r-brace () | |
695 | "Insert `}' and perform balance." | |
696 | (interactive) | |
697 | (insert "}") | |
698 | (ps-mode-r-balance "}")) | |
699 | ||
700 | (defun ps-mode-r-angle () | |
701 | "Insert `]' and perform balance." | |
702 | (interactive) | |
703 | (insert "]") | |
704 | (ps-mode-r-balance "]")) | |
705 | ||
706 | (defun ps-mode-r-gt () | |
707 | "Insert `>' and perform balance." | |
708 | (interactive) | |
709 | (insert ">") | |
710 | (ps-mode-r-balance ">>")) | |
711 | ||
712 | (defun ps-mode-r-balance (right) | |
713 | "Adjust indentification if point after RIGHT." | |
714 | (if ps-mode-auto-indent | |
715 | (save-excursion | |
716 | (when (re-search-backward (concat "^[ \t]*" (regexp-quote right) "\\=") nil t) | |
627a4e30 | 717 | (indent-line-to (ps-mode-target-column))))) |
99485bca GM |
718 | (blink-matching-open)) |
719 | ||
720 | (defun ps-mode-other-newline () | |
9cf2db99 | 721 | "Perform newline in `*ps-run*' buffer." |
99485bca | 722 | (interactive) |
9cf2db99 | 723 | (ps-run-send-string "")) |
99485bca GM |
724 | |
725 | \f | |
726 | ;; Print PostScript. | |
727 | ||
728 | (defun ps-mode-print-buffer () | |
627a4e30 | 729 | "Print buffer as PostScript." |
99485bca | 730 | (interactive) |
627a4e30 | 731 | (funcall ps-mode-print-function)) |
99485bca GM |
732 | |
733 | (defun ps-mode-print-region (begin end) | |
734 | "Print region as PostScript, adding minimal header and footer lines: | |
735 | ||
736 | %!PS | |
737 | <region> | |
627a4e30 | 738 | showpage" |
99485bca | 739 | (interactive "r") |
627a4e30 GM |
740 | (let ((buf (current-buffer))) |
741 | (with-temp-buffer | |
742 | (insert "%!PS\n") | |
743 | (insert-buffer-substring buf begin end) | |
744 | (insert "\nshowpage\n") | |
745 | (funcall ps-mode-print-function)))) | |
99485bca GM |
746 | |
747 | \f | |
748 | ;; Comment Out / Uncomment. | |
749 | ||
750 | (defun ps-mode-comment-out-region (begin end) | |
751 | "Comment out region." | |
752 | (interactive "r") | |
753 | (let ((endm (make-marker))) | |
754 | (set-marker endm end) | |
755 | (save-excursion | |
756 | (goto-char begin) | |
757 | (if (= (current-column) 0) | |
758 | (insert "%")) | |
759 | (while (and (= (forward-line) 0) | |
760 | (< (point) (marker-position endm))) | |
761 | (insert "%"))) | |
762 | (set-marker endm nil))) | |
763 | ||
764 | (defun ps-mode-uncomment-region (begin end) | |
765 | "Uncomment region. | |
766 | ||
767 | Only one `%' is removed, and it has to be in the first column." | |
768 | (interactive "r") | |
769 | (let ((endm (make-marker))) | |
770 | (set-marker endm end) | |
771 | (save-excursion | |
772 | (goto-char begin) | |
773 | (if (looking-at "^%") | |
774 | (delete-char 1)) | |
775 | (while (and (= (forward-line) 0) | |
776 | (< (point) (marker-position endm))) | |
777 | (if (looking-at "%") | |
778 | (delete-char 1)))) | |
779 | (set-marker endm nil))) | |
780 | ||
781 | \f | |
782 | ;; Convert 8-bit to octal codes. | |
783 | ||
784 | (defun ps-mode-octal-buffer () | |
785 | "Change 8-bit characters to octal codes in buffer." | |
786 | (interactive) | |
787 | (ps-mode-octal-region (point-min) (point-max))) | |
788 | ||
789 | (defun ps-mode-octal-region (begin end) | |
790 | "Change 8-bit characters to octal codes in region." | |
791 | (interactive "r") | |
792 | (if buffer-read-only | |
793 | (progn | |
794 | (ding) | |
795 | (message "Buffer is read only")) | |
796 | (save-excursion | |
797 | (let (endm i) | |
798 | (setq endm (make-marker)) | |
799 | (set-marker endm end) | |
800 | (goto-char begin) | |
801 | (setq i 0) | |
802 | (while (re-search-forward "[\200-\377]" (marker-position endm) t) | |
803 | (setq i (1+ i)) | |
804 | (backward-char) | |
805 | (insert (format "\\%03o" (string-to-char (buffer-substring (point) (1+ (point)))))) | |
806 | (delete-char 1)) | |
c22d928f | 807 | (message "%d change%s made" i (if (= i 1) "" "s")) |
99485bca GM |
808 | (set-marker endm nil))))) |
809 | ||
810 | \f | |
811 | ;; Cookbook. | |
812 | ||
813 | (defun ps-mode-center () | |
814 | "Insert function /center." | |
815 | (interactive) | |
816 | (insert " | |
817 | /center { | |
818 | dup stringwidth | |
819 | exch 2 div neg | |
820 | exch 2 div neg | |
821 | rmoveto | |
822 | } bind def | |
823 | ")) | |
824 | ||
825 | (defun ps-mode-right () | |
826 | "Insert function /right." | |
827 | (interactive) | |
828 | (insert " | |
829 | /right { | |
830 | dup stringwidth | |
831 | exch neg | |
832 | exch neg | |
833 | rmoveto | |
834 | } bind def | |
835 | ")) | |
836 | ||
837 | (defun ps-mode-RE () | |
838 | "Insert function /RE." | |
839 | (interactive) | |
840 | (insert " | |
841 | % `new-font-name' `encoding-vector' `old-font-name' RE - | |
842 | /RE { | |
843 | findfont | |
844 | dup maxlength dict begin { | |
845 | 1 index /FID ne { def } { pop pop } ifelse | |
846 | } forall | |
847 | /Encoding exch def | |
848 | dup /FontName exch def | |
849 | currentdict end definefont pop | |
850 | } bind def | |
851 | ")) | |
852 | ||
853 | (defun ps-mode-latin-extended () | |
854 | "Insert array /ISOLatin1Extended. | |
855 | ||
856 | This encoding vector contains all the entries from ISOLatin1Encoding | |
627a4e30 | 857 | plus the usually uncoded characters inserted on positions 1 through 28." |
99485bca GM |
858 | (interactive) |
859 | (insert " | |
860 | % ISOLatin1Encoding, extended with remaining uncoded glyphs | |
861 | /ISOLatin1Extended [ | |
862 | /.notdef /Lslash /lslash /OE /oe /Scaron /scaron /Zcaron /zcaron | |
863 | /Ydieresis /trademark /bullet /dagger /daggerdbl /ellipsis /emdash | |
864 | /endash /fi /fl /florin /fraction /guilsinglleft /guilsinglright | |
865 | /perthousand /quotedblbase /quotedblleft /quotedblright | |
866 | /quotesinglbase /quotesingle /.notdef /.notdef /.notdef /space | |
867 | /exclam /quotedbl /numbersign /dollar /percent /ampersand | |
868 | /quoteright /parenleft /parenright /asterisk /plus /comma /minus | |
869 | /period /slash /zero /one /two /three /four /five /six /seven /eight | |
870 | /nine /colon /semicolon /less /equal /greater /question /at /A /B /C | |
871 | /D /E /F /G /H /I /J /K /L /M /N /O /P /Q /R /S /T /U /V /W /X /Y /Z | |
872 | /bracketleft /backslash /bracketright /asciicircum /underscore | |
873 | /quoteleft /a /b /c /d /e /f /g /h /i /j /k /l /m /n /o /p /q /r /s | |
874 | /t /u /v /w /x /y /z /braceleft /bar /braceright /asciitilde | |
875 | /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef | |
876 | /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef | |
877 | /.notdef /.notdef /.notdef /dotlessi /grave /acute /circumflex | |
878 | /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla | |
879 | /.notdef /hungarumlaut /ogonek /caron /space /exclamdown /cent | |
880 | /sterling /currency /yen /brokenbar /section /dieresis /copyright | |
881 | /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron | |
882 | /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph | |
883 | /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright | |
884 | /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute | |
885 | /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute | |
886 | /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth | |
887 | /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply | |
888 | /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn | |
889 | /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring | |
890 | /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave | |
891 | /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute | |
892 | /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute | |
893 | /ucircumflex /udieresis /yacute /thorn /ydieresis | |
894 | ] def | |
895 | ")) | |
896 | ||
897 | (defun ps-mode-heapsort () | |
898 | "Insert function /Heapsort." | |
899 | (interactive) | |
900 | (insert " | |
901 | % `array-element' Heapsort-cvi-or-cvr-or-cvs `number-or-string' | |
902 | /Heapsort-cvi-or-cvr-or-cvs { | |
903 | % 0 get | |
904 | } bind def | |
905 | % `array' Heapsort `sorted-array' | |
906 | /Heapsort { | |
907 | dup length /hsR exch def | |
908 | /hsL hsR 2 idiv 1 add def | |
909 | { | |
910 | hsR 2 lt { exit } if | |
911 | hsL 1 gt { | |
912 | /hsL hsL 1 sub def | |
913 | } { | |
914 | /hsR hsR 1 sub def | |
915 | dup dup dup 0 get exch dup hsR get | |
916 | 0 exch put | |
917 | hsR exch put | |
918 | } ifelse | |
919 | dup hsL 1 sub get /hsT exch def | |
920 | /hsJ hsL def | |
921 | { | |
922 | /hsS hsJ def | |
923 | /hsJ hsJ dup add def | |
924 | hsJ hsR gt { exit } if | |
925 | hsJ hsR lt { | |
926 | dup dup hsJ 1 sub get Heapsort-cvi-or-cvr-or-cvs | |
927 | exch hsJ get Heapsort-cvi-or-cvr-or-cvs | |
928 | lt { /hsJ hsJ 1 add def } if | |
929 | } if | |
930 | dup hsJ 1 sub get Heapsort-cvi-or-cvr-or-cvs | |
931 | hsT Heapsort-cvi-or-cvr-or-cvs | |
932 | le { exit } if | |
933 | dup dup hsS 1 sub exch hsJ 1 sub get put | |
934 | } loop | |
935 | dup hsS 1 sub hsT put | |
936 | } loop | |
937 | } bind def | |
938 | ")) | |
939 | ||
940 | \f | |
941 | ;; EPSF document lay-out. | |
942 | ||
943 | (defun ps-mode-epsf-sparse () | |
944 | "Insert sparse EPSF template." | |
945 | (interactive) | |
946 | (goto-char (point-max)) | |
947 | (unless (re-search-backward "%%EOF[ \t\n]*\\'" nil t) | |
948 | (goto-char (point-max)) | |
949 | (insert "\n%%EOF\n")) | |
950 | (goto-char (point-max)) | |
951 | (unless (re-search-backward "\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t) | |
952 | (re-search-backward "%%EOF") | |
953 | (insert "showpage\n")) | |
954 | (goto-char (point-max)) | |
955 | (unless (re-search-backward "\\bend[ \t\n]+\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t) | |
956 | (re-search-backward "showpage") | |
957 | (insert "\nend\n")) | |
958 | (goto-char (point-min)) | |
959 | (insert "%!PS-Adobe-3.0 EPSF-3.0\n%%BoundingBox: 0 0 ") | |
960 | (insert (format "%d %d\n\n" | |
961 | (car ps-mode-paper-size) | |
962 | (car (cdr ps-mode-paper-size)))) | |
963 | (insert "64 dict begin\n\n")) | |
964 | ||
965 | (defun ps-mode-epsf-rich () | |
966 | "Insert rich EPSF template." | |
967 | (interactive) | |
968 | (ps-mode-epsf-sparse) | |
969 | (forward-line -3) | |
970 | (when buffer-file-name | |
971 | (insert "%%Title: " (file-name-nondirectory buffer-file-name) "\n")) | |
972 | (insert "%%Creator: " (user-full-name) "\n") | |
973 | (insert "%%CreationDate: " (current-time-string) "\n") | |
974 | (insert "%%EndComments\n") | |
975 | (forward-line 3)) | |
976 | ||
977 | \f | |
978 | ;; Interactive PostScript interpreter. | |
979 | ||
9cf2db99 | 980 | (define-derived-mode ps-run-mode comint-mode "Interactive PS" |
99485bca | 981 | "Major mode in interactive PostScript window. |
627a4e30 | 982 | This mode is invoked from `ps-mode' and should not be called directly. |
99485bca | 983 | |
627a4e30 GM |
984 | \\{ps-run-mode-map}" |
985 | (set (make-local-variable 'font-lock-defaults) | |
986 | '((ps-run-font-lock-keywords | |
987 | ps-run-font-lock-keywords-1 | |
988 | ps-run-font-lock-keywords-2) | |
989 | t)) | |
990 | (setq mode-line-process '(":%s"))) | |
99485bca GM |
991 | |
992 | (defun ps-run-running () | |
627a4e30 | 993 | "Error if not in `ps-mode' or not running PostScript." |
99485bca GM |
994 | (unless (equal major-mode 'ps-mode) |
995 | (error "This function can only be called from PostScript mode")) | |
996 | (unless (equal (process-status "ps-run") 'run) | |
997 | (error "No PostScript process running"))) | |
998 | ||
999 | (defun ps-run-start () | |
1000 | "Start interactive PostScript." | |
1001 | (interactive) | |
627a4e30 | 1002 | (let ((command (or (and window-system ps-run-x) ps-run-dumb)) |
99485bca GM |
1003 | (init-file nil) |
1004 | (process-connection-type nil) | |
627a4e30 | 1005 | (oldwin (selected-window))) |
99485bca GM |
1006 | (unless command |
1007 | (error "No command specified to run interactive PostScript")) | |
1008 | (unless (and ps-run-mark (markerp ps-run-mark)) | |
1009 | (setq ps-run-mark (make-marker))) | |
1010 | (when ps-run-init | |
1011 | (setq init-file (ps-run-make-tmp-filename)) | |
c22d928f | 1012 | (write-region (concat ps-run-init "\n") 0 init-file) |
99485bca | 1013 | (setq init-file (list init-file))) |
9cf2db99 | 1014 | (pop-to-buffer "*ps-run*") |
99485bca GM |
1015 | (ps-run-mode) |
1016 | (when (process-status "ps-run") | |
1017 | (delete-process "ps-run")) | |
1018 | (erase-buffer) | |
627a4e30 GM |
1019 | (setq command (append command init-file)) |
1020 | (insert (mapconcat 'identity command " ") "\n") | |
9cf2db99 MT |
1021 | (apply 'make-comint "ps-run" (car command) nil (cdr command)) |
1022 | (with-current-buffer "*ps-run*" | |
1023 | (use-local-map ps-run-mode-map) | |
1024 | (setq comint-prompt-regexp ps-run-prompt)) | |
99485bca GM |
1025 | (select-window oldwin))) |
1026 | ||
1027 | (defun ps-run-quit () | |
1028 | "Quit interactive PostScript." | |
1029 | (interactive) | |
9cf2db99 | 1030 | (ps-run-send-string "quit") |
99485bca GM |
1031 | (ps-run-cleanup)) |
1032 | ||
1033 | (defun ps-run-kill () | |
1034 | "Kill interactive PostScript." | |
1035 | (interactive) | |
1036 | (delete-process "ps-run") | |
1037 | (ps-run-cleanup)) | |
1038 | ||
1039 | (defun ps-run-clear () | |
1040 | "Clear/reset PostScript graphics." | |
1041 | (interactive) | |
9cf2db99 | 1042 | (ps-run-send-string "showpage") |
99485bca | 1043 | (sit-for 1) |
9cf2db99 | 1044 | (ps-run-send-string "")) |
99485bca GM |
1045 | |
1046 | (defun ps-run-buffer () | |
1047 | "Send buffer to PostScript interpreter." | |
1048 | (interactive) | |
1049 | (ps-run-region (point-min) (point-max))) | |
1050 | ||
1051 | (defun ps-run-region (begin end) | |
1052 | "Send region to PostScript interpreter." | |
1053 | (interactive "r") | |
1054 | (ps-run-running) | |
1055 | (setq ps-run-parent (buffer-name)) | |
1056 | (let ((f (ps-run-make-tmp-filename))) | |
1057 | (set-marker ps-run-mark begin) | |
1058 | (write-region begin end f) | |
9cf2db99 | 1059 | (ps-run-send-string (format "(%s) run" f)))) |
99485bca GM |
1060 | |
1061 | (defun ps-run-boundingbox () | |
627a4e30 | 1062 | "View BoundingBox." |
99485bca GM |
1063 | (interactive) |
1064 | (ps-run-running) | |
1065 | (let (x1 y1 x2 y2 f | |
1066 | (buf (current-buffer))) | |
1067 | (save-excursion | |
1068 | (goto-char 1) | |
1069 | (re-search-forward | |
1070 | "^%%BoundingBox:[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)") | |
1071 | (setq x1 (match-string 1) | |
1072 | y1 (match-string 2) | |
1073 | x2 (match-string 3) | |
1074 | y2 (match-string 4))) | |
1075 | (unless (< (string-to-number x1) (string-to-number x2)) | |
1076 | (error "x1 (%s) should be less than x2 (%s)" x1 x2)) | |
1077 | (unless (< (string-to-number y1) (string-to-number y2)) | |
1078 | (error "y1 (%s) should be less than y2 (%s)" y1 y2)) | |
1079 | (setq f (ps-run-make-tmp-filename)) | |
1080 | (write-region | |
1081 | (format | |
1082 | "gsave | |
1083 | initgraphics | |
1084 | 2 setlinewidth | |
1085 | %s %s moveto | |
1086 | %s %s lineto | |
1087 | %s %s lineto | |
1088 | %s %s lineto | |
1089 | closepath | |
1090 | gsave | |
1091 | [ 4 20 ] 0 setdash | |
1092 | 1 0 0 setrgbcolor | |
1093 | stroke | |
1094 | grestore | |
1095 | gsave | |
1096 | [ 4 20 ] 8 setdash | |
1097 | 0 1 0 setrgbcolor | |
1098 | stroke | |
1099 | grestore | |
1100 | [ 4 20 ] 16 setdash | |
1101 | 0 0 1 setrgbcolor | |
1102 | stroke | |
1103 | grestore | |
1104 | " x1 y1 x2 y1 x2 y2 x1 y2) | |
1105 | 0 | |
1106 | f) | |
9cf2db99 | 1107 | (ps-run-send-string (format "(%s) run" f)) |
99485bca GM |
1108 | (set-buffer buf))) |
1109 | ||
9cf2db99 | 1110 | (defun ps-run-send-string (string) |
99485bca | 1111 | (let ((oldwin (selected-window))) |
9cf2db99 MT |
1112 | (pop-to-buffer "*ps-run*") |
1113 | (comint-goto-process-mark) | |
1114 | (insert string) | |
1115 | (comint-send-input) | |
99485bca GM |
1116 | (select-window oldwin))) |
1117 | ||
1118 | (defun ps-run-make-tmp-filename () | |
1119 | (unless ps-mode-tmp-file | |
99485bca | 1120 | (setq ps-mode-tmp-file |
fa8c4a38 CY |
1121 | (let ((temporary-file-directory (or ps-run-tmp-dir |
1122 | temporary-file-directory))) | |
1123 | (make-temp-file "ps-run-")))) | |
99485bca GM |
1124 | ps-mode-tmp-file) |
1125 | ||
1126 | ;; Remove temporary file | |
1127 | ;; This shouldn't fail twice, because it is called at kill-emacs | |
1128 | (defun ps-run-cleanup () | |
1129 | (when ps-mode-tmp-file | |
1130 | (let ((i ps-mode-tmp-file)) | |
1131 | (setq ps-mode-tmp-file nil) | |
1132 | (when (file-exists-p i) | |
1133 | (delete-file i))))) | |
1134 | ||
1135 | (defun ps-run-mouse-goto-error (event) | |
627a4e30 | 1136 | "Set point at mouse click, then call `ps-run-goto-error'." |
99485bca GM |
1137 | (interactive "e") |
1138 | (mouse-set-point event) | |
1139 | (ps-run-goto-error)) | |
1140 | ||
99485bca GM |
1141 | (defun ps-run-goto-error () |
1142 | "Jump to buffer position read as integer at point. | |
627a4e30 | 1143 | Use line numbers if `ps-run-error-line-numbers' is not nil" |
99485bca GM |
1144 | (interactive) |
1145 | (let ((p (point))) | |
1146 | (unless (looking-at "[0-9]") | |
1147 | (goto-char (max 1 (1- (point))))) | |
1148 | (when (looking-at "[0-9]") | |
1149 | (forward-char 1) | |
1150 | (forward-word -1) | |
1151 | (when (looking-at "[0-9]+") | |
1152 | (let (i) | |
1153 | (setq | |
1154 | i | |
027a4b6b | 1155 | (string-to-number |
99485bca GM |
1156 | (buffer-substring (match-beginning 0) (match-end 0)))) |
1157 | (goto-char p) | |
1158 | (pop-to-buffer ps-run-parent) | |
1159 | (if ps-run-error-line-numbers | |
1160 | (progn | |
1161 | (goto-char (marker-position ps-run-mark)) | |
1162 | (forward-line (1- i)) | |
1163 | (end-of-line)) | |
1164 | (goto-char (+ i (marker-position ps-run-mark))))))))) | |
1165 | ||
1166 | \f | |
1167 | ;; | |
1168 | (add-hook 'kill-emacs-hook 'ps-run-cleanup) | |
1169 | ||
1170 | (provide 'ps-mode) | |
1171 | ||
cbee283d | 1172 | ;; arch-tag: dce13d2d-69fb-4ec4-9d5d-6dd29c3f0e6e |
99485bca | 1173 | ;;; ps-mode.el ends here |