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