Commit | Line | Data |
---|---|---|
99485bca GM |
1 | ;;; ps-mode.el --- PostScript mode for GNU Emacs. |
2 | ||
3 | ;; Copyright (C) 1999 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Peter Kleiweg <kleiweg@let.rug.nl> | |
6 | ;; Maintainer: Peter Kleiweg <kleiweg@let.rug.nl> | |
7 | ;; Created: 20 Aug 1997 | |
8f011fdc | 8 | ;; Version: 1.1e, 11 Nov 1999 |
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 | ||
8f011fdc | 33 | (defconst ps-mode-version "1.1e, 11 Nov 1999") |
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 | ||
c22d928f GM |
107 | (defcustom ps-mode-print-function |
108 | '(lambda () | |
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)) | |
132 | ("^\\(Current file position is\\) \\([0-9]+\\)" | |
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 GM |
164 | |
165 | You won't need to set this option for Ghostscript. | |
166 | " | |
167 | :group 'PostScript-interaction | |
168 | :type '(choice (const nil) string)) | |
169 | ||
170 | (defcustom ps-run-error-line-numbers nil | |
171 | "*What values are used by the PostScript interpreter in error messages?" | |
172 | :group 'PostScript-interaction | |
173 | :type '(choice (const :tag "line numbers" t) | |
174 | (const :tag "byte counts" nil))) | |
175 | ||
176 | (defcustom ps-run-tmp-dir nil | |
177 | "*Name of directory to place temporary file. | |
178 | ||
179 | If nil, the following are tried in turn, until success: | |
180 | 1. \"$TEMP\" | |
181 | 2. \"$TMP\" | |
182 | 3. \"$HOME/tmp\" | |
183 | 4. \"/tmp\" | |
184 | " | |
185 | :group 'PostScript-interaction | |
186 | :type '(choice (const nil) directory)) | |
187 | ||
188 | \f | |
189 | ;; Constants used for font-lock. | |
190 | ||
191 | ;; Only a small set of the PostScript operators is selected for fontification. | |
192 | ;; Fontification is meant to clarify the document structure and process flow, | |
193 | ;; fontifying all known PostScript operators would hinder that objective. | |
194 | (defconst ps-mode-operators | |
195 | (let ((ops '("clear" "mark" "cleartomark" "counttomark" | |
196 | "forall" | |
197 | "dict" "begin" "end" "def" | |
198 | "true" "false" | |
199 | "exec" "if" "ifelse" "for" "repeat" "loop" "exit" | |
200 | "stop" "stopped" "countexecstack" "execstack" | |
201 | "quit" "start" | |
202 | "save" "restore" | |
203 | "bind" "null" | |
204 | "gsave" "grestore" "grestoreall" | |
205 | "showpage"))) | |
206 | (concat "\\<" (regexp-opt ops t) "\\>")) | |
207 | "Regexp of PostScript operators that will be fontified") | |
208 | ||
209 | ;; Level 1 font-lock: | |
210 | ;; - Special comments (reference face) | |
211 | ;; - Strings and other comments | |
212 | ;; - Partial strings (warning face) | |
213 | ;; - 8bit characters (warning face) | |
214 | ;; Multiline strings are not supported. Strings with nested brackets are. | |
215 | (defconst ps-mode-font-lock-keywords-1 | |
216 | '(("\\`%!PS.*" . font-lock-reference-face) | |
217 | ("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$" | |
218 | . font-lock-reference-face) | |
219 | (ps-mode-match-string-or-comment | |
220 | (1 font-lock-comment-face nil t) | |
221 | (2 font-lock-string-face nil t)) | |
222 | ("([^()\n%]*\\|[^()\n]*)" . font-lock-warning-face) | |
223 | ("[\200-\377]+" (0 font-lock-warning-face prepend nil))) | |
224 | "Subdued level highlighting for PostScript mode.") | |
225 | ||
226 | ;; Level 2 font-lock: | |
227 | ;; - All from level 1 | |
228 | ;; - PostScript operators (keyword face) | |
229 | (defconst ps-mode-font-lock-keywords-2 | |
230 | (append | |
231 | ps-mode-font-lock-keywords-1 | |
232 | (list | |
233 | (cons | |
234 | ;; exclude names prepended by `/' | |
235 | (concat "\\(^\\|[^/\n]\\)" ps-mode-operators) | |
236 | '(2 font-lock-keyword-face)))) | |
237 | "Medium level highlighting for PostScript mode.") | |
238 | ||
239 | ;; Level 3 font-lock: | |
240 | ;; - All from level 2 | |
241 | ;; - Immediately evaluated names: those starting with `//' (type face) | |
242 | ;; - Names that look like they are used for the definition of: | |
243 | ;; * a function | |
244 | ;; * an array | |
245 | ;; * a dictionary | |
246 | ;; * a "global" variable | |
247 | ;; (function name face) | |
248 | ;; - Other names (variable name face) | |
249 | ;; The rules used to determine what names fit in the first category are: | |
250 | ;; - Only names that are at the left margin, and one of these on the same line: | |
251 | ;; * Nothing after the name except possibly one or more `[' or a comment | |
252 | ;; * A `{' or `<<' or `[0-9]+ dict' following the name | |
253 | ;; * A `def' somewhere in the same line | |
254 | ;; Names are fontified before PostScript operators, allowing the use of | |
255 | ;; a more simple (efficient) regexp than the one used in level 2. | |
256 | (defconst ps-mode-font-lock-keywords-3 | |
257 | (append | |
258 | ps-mode-font-lock-keywords-1 | |
259 | (list | |
260 | '("//\\w+" . font-lock-type-face) | |
261 | '("^\\(/\\w+\\)\\>[[ \t]*\\(%.*\\)?\r?$" | |
262 | . (1 font-lock-function-name-face)) | |
263 | '("^\\(/\\w+\\)\\>\\([ \t]*{\\|[ \t]*<<\\|.*\\<def\\>\\|[ \t]+[0-9]+[ \t]+dict\\>\\)" | |
264 | . (1 font-lock-function-name-face)) | |
265 | '("/\\w+" . font-lock-variable-name-face) | |
266 | (cons ps-mode-operators 'font-lock-keyword-face))) | |
267 | "High level highliting for PostScript mode.") | |
268 | ||
269 | (defconst ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1 | |
270 | "Default expressions to highlight in PostScript mode.") | |
271 | ||
272 | ;; Level 1 font-lock for ps-run-mode | |
273 | ;; - prompt (function name face) | |
274 | (defconst ps-run-font-lock-keywords-1 | |
c22d928f GM |
275 | (unless (string= "" ps-run-prompt) |
276 | (list (cons (if (= ?^ (string-to-char ps-run-prompt)) | |
277 | ps-run-prompt | |
278 | (concat "^" ps-run-prompt)) | |
279 | 'font-lock-function-name-face))) | |
99485bca GM |
280 | "Subdued level highlighting for PostScript run mode.") |
281 | ||
282 | (defconst ps-run-font-lock-keywords ps-run-font-lock-keywords-1 | |
283 | "Default expressions to highlight in PostScript run mode.") | |
284 | ||
285 | \f | |
286 | ;; Variables. | |
287 | ||
288 | (defvar ps-mode-map nil | |
289 | "Local keymap to use in PostScript mode.") | |
290 | ||
291 | (defvar ps-mode-syntax-table nil | |
292 | "Syntax table used while in PostScript mode.") | |
293 | ||
294 | (defvar ps-run-mode-map nil | |
295 | "Local keymap to use in PostScript run mode.") | |
296 | ||
297 | (defvar ps-mode-tmp-file nil | |
298 | "Name of temporary file, set by `ps-run'.") | |
299 | ||
300 | (defvar ps-run-mark nil | |
301 | "Mark to start of region that was sent to PostScript interpreter.") | |
302 | ||
303 | (defvar ps-run-parent nil | |
304 | "Parent window of interactive PostScript.") | |
305 | ||
306 | \f | |
307 | ;; Menu | |
308 | ||
309 | (defconst ps-mode-menu-main | |
310 | '("PostScript" | |
311 | ["EPSF Template, Sparse" ps-mode-epsf-sparse t] | |
312 | ["EPSF Template, Rich" ps-mode-epsf-rich t] | |
313 | "---" | |
314 | ("Cookbook" | |
315 | ["RE" ps-mode-RE t] | |
316 | ["ISOLatin1Extended" ps-mode-latin-extended t] | |
317 | ["center" ps-mode-center t] | |
318 | ["right" ps-mode-right t] | |
319 | ["Heapsort" ps-mode-heapsort t]) | |
320 | ("Fonts (1)" | |
321 | ["Times-Roman" (insert "/Times-Roman ") t] | |
322 | ["Times-Bold" (insert "/Times-Bold ") t] | |
323 | ["Times-Italic" (insert "/Times-Italic ") t] | |
324 | ["Times-BoldItalic" (insert "/Times-BoldItalic ") t] | |
325 | ["Helvetica" (insert "/Helvetica ") t] | |
326 | ["Helvetica-Bold" (insert "/Helvetica-Bold ") t] | |
327 | ["Helvetica-Oblique" (insert "/Helvetica-Oblique ") t] | |
328 | ["Helvetica-BoldOblique" (insert "/Helvetica-BoldOblique ") t] | |
329 | ["Courier" (insert "/Courier ") t] | |
330 | ["Courier-Bold" (insert "/Courier-Bold ") t] | |
331 | ["Courier-Oblique" (insert "/Courier-Oblique ") t] | |
332 | ["Courier-BoldOblique" (insert "/Courier-BoldOblique ") t] | |
333 | ["Symbol" (insert "/Symbol") t ]) | |
334 | ("Fonts (2)" | |
335 | ["AvantGarde-Book" (insert "/AvantGarde-Book ") t] | |
336 | ["AvantGarde-Demi" (insert "/AvantGarde-Demi ") t] | |
337 | ["AvantGarde-BookOblique" (insert "/AvantGarde-BookOblique ") t] | |
338 | ["AvantGarde-DemiOblique" (insert "/AvantGarde-DemiOblique ") t] | |
339 | ["Bookman-Light" (insert "/Bookman-Light ") t] | |
340 | ["Bookman-Demi" (insert "/Bookman-Demi ") t] | |
341 | ["Bookman-LightItalic" (insert "/Bookman-LightItalic ") t] | |
342 | ["Bookman-DemiItalic" (insert "/Bookman-DemiItalic ") t] | |
343 | ["Helvetica-Narrow" (insert "/Helvetica-Narrow ") t] | |
344 | ["Helvetica-Narrow-Bold" (insert "/Helvetica-Narrow-Bold ") t] | |
345 | ["Helvetica-Narrow-Oblique" (insert "/Helvetica-Narrow-Oblique ") t] | |
346 | ["Helvetica-Narrow-BoldOblique" (insert "/Helvetica-Narrow-BoldOblique ") t] | |
347 | ["NewCenturySchlbk-Roman" (insert "/NewCenturySchlbk-Roman ") t] | |
348 | ["NewCenturySchlbk-Bold" (insert "/NewCenturySchlbk-Bold ") t] | |
349 | ["NewCenturySchlbk-Italic" (insert "/NewCenturySchlbk-Italic ") t] | |
350 | ["NewCenturySchlbk-BoldItalic" (insert "/NewCenturySchlbk-BoldItalic ") t] | |
351 | ["Palatino-Roman" (insert "/Palatino-Roman ") t] | |
352 | ["Palatino-Bold" (insert "/Palatino-Bold ") t] | |
353 | ["Palatino-Italic" (insert "/Palatino-Italic ") t] | |
354 | ["Palatino-BoldItalic" (insert "/Palatino-BoldItalic ") t] | |
355 | ["ZapfChancery-MediumItalic" (insert "/ZapfChancery-MediumItalic ") t] | |
356 | ["ZapfDingbats" (insert "/ZapfDingbats ") t]) | |
357 | "---" | |
358 | ["Comment Out Region" ps-mode-comment-out-region (mark t)] | |
359 | ["Uncomment Region" ps-mode-uncomment-region (mark t)] | |
360 | "---" | |
361 | ["8-bit to Octal Buffer" ps-mode-octal-buffer t] | |
362 | ["8-bit to Octal Region" ps-mode-octal-region (mark t)] | |
363 | "---" | |
364 | ("Auto Indent" | |
365 | ["On" (setq ps-mode-auto-indent t) (not ps-mode-auto-indent)] | |
366 | ["Off" (setq ps-mode-auto-indent nil) ps-mode-auto-indent]) | |
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)) | |
445 | ||
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) | |
452 | ||
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) | |
475 | ||
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 | ||
484 | ;;;###autoload | |
485 | (defun ps-mode () | |
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 | ||
493 | ps-mode-auto-indent | |
494 | ps-mode-tab | |
495 | ps-mode-paper-size | |
496 | ps-mode-print-function | |
99485bca | 497 | ps-run-prompt |
c22d928f | 498 | ps-run-font-lock-keywords-2 |
99485bca GM |
499 | ps-run-x |
500 | ps-run-dumb | |
501 | ps-run-init | |
502 | ps-run-error-line-numbers | |
c22d928f | 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. | |
522 | Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect. | |
523 | " | |
524 | (interactive) | |
525 | (kill-all-local-variables) | |
526 | (make-local-variable 'font-lock-defaults) | |
527 | (setq font-lock-defaults '((ps-mode-font-lock-keywords | |
528 | ps-mode-font-lock-keywords-1 | |
529 | ps-mode-font-lock-keywords-2 | |
530 | ps-mode-font-lock-keywords-3) | |
531 | t) | |
532 | major-mode 'ps-mode | |
533 | mode-name "PostScript") | |
534 | (use-local-map ps-mode-map) | |
535 | (set-syntax-table ps-mode-syntax-table) | |
0ad0386e DL |
536 | (set (make-local-variable 'comment-start) "%") |
537 | (set (make-local-variable 'comment-start-skip) | |
538 | "\\(\\(^\\|[^\\]\\)\\(\\\\\\\\\\)*\\)\\(%+ *\\)") | |
99485bca GM |
539 | (run-hooks 'ps-mode-hook)) |
540 | ||
c22d928f GM |
541 | (defun ps-mode-show-version () |
542 | "Show current version of PostScript mode" | |
543 | (interactive) | |
544 | (message " *** PostScript Mode (ps-mode) Version %s *** " ps-mode-version)) | |
545 | ||
aebf9ad1 GM |
546 | (defun ps-mode-submit-bug-report () |
547 | "Submit via mail a bug report on PostScript mode" | |
548 | (interactive) | |
549 | (when (y-or-n-p "Submit bug report on PostScript mode? ") | |
8f011fdc GM |
550 | (let ((reporter-prompt-for-summary-p nil) |
551 | (reporter-dont-compact-list '(ps-mode-print-function | |
552 | ps-run-font-lock-keywords-2))) | |
aebf9ad1 GM |
553 | (reporter-submit-bug-report |
554 | ps-mode-maintainer-address | |
8f011fdc GM |
555 | (format "ps-mode.el %s [%s]" ps-mode-version system-type) |
556 | '(ps-mode-auto-indent | |
557 | ps-mode-tab | |
558 | ps-mode-paper-size | |
559 | ps-mode-print-function | |
560 | ps-run-prompt | |
561 | ps-run-font-lock-keywords-2 | |
562 | ps-run-x | |
563 | ps-run-dumb | |
564 | ps-run-init | |
565 | ps-run-error-line-numbers | |
566 | ps-run-tmp-dir))))) | |
aebf9ad1 | 567 | |
99485bca GM |
568 | \f |
569 | ;; Helper functions for font-lock. | |
570 | ||
571 | ;; When this function is called, point is at an opening bracket. | |
572 | ;; This function should test if point is at the start of a string | |
573 | ;; with nested brackets. | |
574 | ;; If true: move point to end of string | |
575 | ;; set string to match data nr 2 | |
576 | ;; return new point | |
577 | ;; If false: return nil | |
578 | (defun ps-mode-looking-at-nested (limit) | |
579 | (let ((first (point)) | |
580 | (level 1) | |
581 | pos) | |
582 | ;; Move past opening bracket. | |
583 | (forward-char 1) | |
584 | (setq pos (point)) | |
585 | (while (and (> level 0) (< pos limit)) | |
586 | ;; Search next bracket, stepping over escaped brackets. | |
587 | (if (not (looking-at "\\([^()\\\n]\\|\\\\.\\)*\\([()]\\)")) | |
588 | (setq level -1) | |
589 | (if (string= "(" (match-string 2)) | |
590 | (setq level (1+ level)) | |
591 | (setq level (1- level))) | |
592 | (goto-char (setq pos (match-end 0))))) | |
593 | (if (not (= level 0)) | |
594 | nil | |
595 | ;; Found string with nested brackets, now set match data nr 2. | |
596 | (goto-char first) | |
597 | (re-search-forward "\\(%\\)\\|\\((.*\\)" pos)))) | |
598 | ||
599 | ;; This function should search for a string or comment | |
600 | ;; If comment, return as match data nr 1 | |
601 | ;; If string, return as match data nr 2 | |
602 | (defun ps-mode-match-string-or-comment (limit) | |
603 | ;; Find the first potential match. | |
604 | (if (not (re-search-forward "[%(]" limit t)) | |
605 | ;; Nothing found: return failure. | |
606 | nil | |
607 | (let (end) | |
608 | (goto-char (match-beginning 0)) | |
609 | (setq end (match-end 0)) | |
610 | (cond ((looking-at "\\(%.*\\)\\|\\((\\([^()\\\n]\\|\\\\.\\)*)\\)") | |
611 | ;; It's a comment or string without nested, unescaped brackets. | |
612 | (goto-char (match-end 0)) | |
613 | (point)) | |
614 | ((ps-mode-looking-at-nested limit) | |
615 | ;; It's a string with nested brackets. | |
616 | (point)) | |
617 | (t | |
618 | ;; Try next match. | |
619 | (goto-char end) | |
620 | (ps-mode-match-string-or-comment limit)))))) | |
621 | ||
622 | \f | |
623 | ;; Key-handlers. | |
624 | ||
625 | (defun ps-mode-target-column () | |
626 | "To what column should text on current line be indented? | |
627 | ||
628 | Identation is increased if the last token on the current line | |
629 | defines the beginning of a group. These tokens are: { [ <<" | |
630 | (save-excursion | |
631 | (beginning-of-line) | |
632 | (if (looking-at "[ \t]*\\(}\\|\\]\\|>>\\)") | |
633 | (condition-case err | |
634 | (progn | |
635 | (goto-char (match-end 0)) | |
636 | (backward-sexp 1) | |
637 | (beginning-of-line) | |
638 | (if (looking-at "[ \t]+") | |
639 | (goto-char (match-end 0))) | |
640 | (current-column)) | |
641 | (error | |
642 | (ding) | |
643 | (message (error-message-string err)) | |
644 | 0)) | |
645 | (let (target) | |
646 | (if (not (re-search-backward "[^ \t\n\r\f][ \t\n\r\f]*\\=" nil t)) | |
647 | 0 | |
648 | (goto-char (match-beginning 0)) | |
649 | (beginning-of-line) | |
650 | (if (looking-at "[ \t]+") | |
651 | (goto-char (match-end 0))) | |
652 | (setq target (current-column)) | |
653 | (end-of-line) | |
654 | (if (re-search-backward "\\({\\|\\[\\|<<\\)[ \t]*\\(%[^\n]*\\)?\\=" nil t) | |
655 | (setq target (+ target ps-mode-tab))) | |
656 | target))))) | |
657 | ||
658 | (defun ps-mode-newline () | |
659 | "Insert newline with proper indentation." | |
660 | (interactive) | |
661 | (delete-horizontal-space) | |
662 | (insert "\n") | |
663 | (if ps-mode-auto-indent | |
664 | (indent-to (ps-mode-target-column)))) | |
665 | ||
666 | (defun ps-mode-tabkey () | |
667 | "Indent/reindent current line, or insert tab" | |
668 | (interactive) | |
669 | (let ((column (current-column)) | |
670 | target) | |
671 | (if (or (not ps-mode-auto-indent) | |
672 | (< ps-mode-tab 1) | |
673 | (not (re-search-backward "^[ \t]*\\=" nil t))) | |
674 | (insert "\t") | |
675 | (setq target (ps-mode-target-column)) | |
676 | (while (<= target column) | |
677 | (setq target (+ target ps-mode-tab))) | |
678 | (delete-horizontal-space) | |
679 | (indent-to target)))) | |
680 | ||
681 | (defun ps-mode-backward-delete-char () | |
682 | "Delete backward indentation, or delete backward character" | |
683 | (interactive) | |
684 | (let ((column (current-column)) | |
685 | target) | |
686 | (if (or (not ps-mode-auto-indent) | |
687 | (< ps-mode-tab 1) | |
688 | (not (re-search-backward "^[ \t]+\\=" nil t))) | |
689 | (delete-backward-char 1) | |
690 | (setq target (ps-mode-target-column)) | |
691 | (while (> column target) | |
692 | (setq target (+ target ps-mode-tab))) | |
693 | (while (>= target column) | |
694 | (setq target (- target ps-mode-tab))) | |
695 | (if (< target 0) | |
696 | (setq target 0)) | |
697 | (delete-horizontal-space) | |
698 | (indent-to target)))) | |
699 | ||
700 | (defun ps-mode-r-brace () | |
701 | "Insert `}' and perform balance." | |
702 | (interactive) | |
703 | (insert "}") | |
704 | (ps-mode-r-balance "}")) | |
705 | ||
706 | (defun ps-mode-r-angle () | |
707 | "Insert `]' and perform balance." | |
708 | (interactive) | |
709 | (insert "]") | |
710 | (ps-mode-r-balance "]")) | |
711 | ||
712 | (defun ps-mode-r-gt () | |
713 | "Insert `>' and perform balance." | |
714 | (interactive) | |
715 | (insert ">") | |
716 | (ps-mode-r-balance ">>")) | |
717 | ||
718 | (defun ps-mode-r-balance (right) | |
719 | "Adjust indentification if point after RIGHT." | |
720 | (if ps-mode-auto-indent | |
721 | (save-excursion | |
722 | (when (re-search-backward (concat "^[ \t]*" (regexp-quote right) "\\=") nil t) | |
723 | (delete-horizontal-space) | |
724 | (indent-to (ps-mode-target-column))))) | |
725 | (blink-matching-open)) | |
726 | ||
727 | (defun ps-mode-other-newline () | |
728 | "Perform newline in `*ps run*' buffer" | |
729 | (interactive) | |
730 | (let ((buf (current-buffer))) | |
731 | (set-buffer "*ps run*") | |
732 | (ps-run-newline) | |
733 | (set-buffer buf))) | |
734 | ||
735 | \f | |
736 | ;; Print PostScript. | |
737 | ||
738 | (defun ps-mode-print-buffer () | |
739 | "Print buffer as PostScript" | |
740 | (interactive) | |
741 | (eval (list ps-mode-print-function))) | |
742 | ||
743 | (defun ps-mode-print-region (begin end) | |
744 | "Print region as PostScript, adding minimal header and footer lines: | |
745 | ||
746 | %!PS | |
747 | <region> | |
748 | showpage | |
749 | " | |
750 | (interactive "r") | |
751 | (let ((oldbuf (current-buffer)) | |
752 | (tmpbuf (get-buffer-create "*ps print*"))) | |
753 | (copy-to-buffer tmpbuf begin end) | |
754 | (set-buffer tmpbuf) | |
755 | (goto-char 1) | |
756 | (insert "%!PS\n") | |
757 | (goto-char (point-max)) | |
758 | (insert "\nshowpage\n") | |
759 | (eval (list ps-mode-print-function)) | |
760 | (set-buffer oldbuf) | |
761 | (kill-buffer tmpbuf))) | |
762 | ||
763 | \f | |
764 | ;; Comment Out / Uncomment. | |
765 | ||
766 | (defun ps-mode-comment-out-region (begin end) | |
767 | "Comment out region." | |
768 | (interactive "r") | |
769 | (let ((endm (make-marker))) | |
770 | (set-marker endm end) | |
771 | (save-excursion | |
772 | (goto-char begin) | |
773 | (if (= (current-column) 0) | |
774 | (insert "%")) | |
775 | (while (and (= (forward-line) 0) | |
776 | (< (point) (marker-position endm))) | |
777 | (insert "%"))) | |
778 | (set-marker endm nil))) | |
779 | ||
780 | (defun ps-mode-uncomment-region (begin end) | |
781 | "Uncomment region. | |
782 | ||
783 | Only one `%' is removed, and it has to be in the first column." | |
784 | (interactive "r") | |
785 | (let ((endm (make-marker))) | |
786 | (set-marker endm end) | |
787 | (save-excursion | |
788 | (goto-char begin) | |
789 | (if (looking-at "^%") | |
790 | (delete-char 1)) | |
791 | (while (and (= (forward-line) 0) | |
792 | (< (point) (marker-position endm))) | |
793 | (if (looking-at "%") | |
794 | (delete-char 1)))) | |
795 | (set-marker endm nil))) | |
796 | ||
797 | \f | |
798 | ;; Convert 8-bit to octal codes. | |
799 | ||
800 | (defun ps-mode-octal-buffer () | |
801 | "Change 8-bit characters to octal codes in buffer." | |
802 | (interactive) | |
803 | (ps-mode-octal-region (point-min) (point-max))) | |
804 | ||
805 | (defun ps-mode-octal-region (begin end) | |
806 | "Change 8-bit characters to octal codes in region." | |
807 | (interactive "r") | |
808 | (if buffer-read-only | |
809 | (progn | |
810 | (ding) | |
811 | (message "Buffer is read only")) | |
812 | (save-excursion | |
813 | (let (endm i) | |
814 | (setq endm (make-marker)) | |
815 | (set-marker endm end) | |
816 | (goto-char begin) | |
817 | (setq i 0) | |
818 | (while (re-search-forward "[\200-\377]" (marker-position endm) t) | |
819 | (setq i (1+ i)) | |
820 | (backward-char) | |
821 | (insert (format "\\%03o" (string-to-char (buffer-substring (point) (1+ (point)))))) | |
822 | (delete-char 1)) | |
c22d928f | 823 | (message "%d change%s made" i (if (= i 1) "" "s")) |
99485bca GM |
824 | (set-marker endm nil))))) |
825 | ||
826 | \f | |
827 | ;; Cookbook. | |
828 | ||
829 | (defun ps-mode-center () | |
830 | "Insert function /center." | |
831 | (interactive) | |
832 | (insert " | |
833 | /center { | |
834 | dup stringwidth | |
835 | exch 2 div neg | |
836 | exch 2 div neg | |
837 | rmoveto | |
838 | } bind def | |
839 | ")) | |
840 | ||
841 | (defun ps-mode-right () | |
842 | "Insert function /right." | |
843 | (interactive) | |
844 | (insert " | |
845 | /right { | |
846 | dup stringwidth | |
847 | exch neg | |
848 | exch neg | |
849 | rmoveto | |
850 | } bind def | |
851 | ")) | |
852 | ||
853 | (defun ps-mode-RE () | |
854 | "Insert function /RE." | |
855 | (interactive) | |
856 | (insert " | |
857 | % `new-font-name' `encoding-vector' `old-font-name' RE - | |
858 | /RE { | |
859 | findfont | |
860 | dup maxlength dict begin { | |
861 | 1 index /FID ne { def } { pop pop } ifelse | |
862 | } forall | |
863 | /Encoding exch def | |
864 | dup /FontName exch def | |
865 | currentdict end definefont pop | |
866 | } bind def | |
867 | ")) | |
868 | ||
869 | (defun ps-mode-latin-extended () | |
870 | "Insert array /ISOLatin1Extended. | |
871 | ||
872 | This encoding vector contains all the entries from ISOLatin1Encoding | |
873 | plus the usually uncoded characters inserted on positions 1 through 28. | |
874 | " | |
875 | (interactive) | |
876 | (insert " | |
877 | % ISOLatin1Encoding, extended with remaining uncoded glyphs | |
878 | /ISOLatin1Extended [ | |
879 | /.notdef /Lslash /lslash /OE /oe /Scaron /scaron /Zcaron /zcaron | |
880 | /Ydieresis /trademark /bullet /dagger /daggerdbl /ellipsis /emdash | |
881 | /endash /fi /fl /florin /fraction /guilsinglleft /guilsinglright | |
882 | /perthousand /quotedblbase /quotedblleft /quotedblright | |
883 | /quotesinglbase /quotesingle /.notdef /.notdef /.notdef /space | |
884 | /exclam /quotedbl /numbersign /dollar /percent /ampersand | |
885 | /quoteright /parenleft /parenright /asterisk /plus /comma /minus | |
886 | /period /slash /zero /one /two /three /four /five /six /seven /eight | |
887 | /nine /colon /semicolon /less /equal /greater /question /at /A /B /C | |
888 | /D /E /F /G /H /I /J /K /L /M /N /O /P /Q /R /S /T /U /V /W /X /Y /Z | |
889 | /bracketleft /backslash /bracketright /asciicircum /underscore | |
890 | /quoteleft /a /b /c /d /e /f /g /h /i /j /k /l /m /n /o /p /q /r /s | |
891 | /t /u /v /w /x /y /z /braceleft /bar /braceright /asciitilde | |
892 | /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef | |
893 | /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef | |
894 | /.notdef /.notdef /.notdef /dotlessi /grave /acute /circumflex | |
895 | /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla | |
896 | /.notdef /hungarumlaut /ogonek /caron /space /exclamdown /cent | |
897 | /sterling /currency /yen /brokenbar /section /dieresis /copyright | |
898 | /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron | |
899 | /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph | |
900 | /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright | |
901 | /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute | |
902 | /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute | |
903 | /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth | |
904 | /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply | |
905 | /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn | |
906 | /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring | |
907 | /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave | |
908 | /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute | |
909 | /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute | |
910 | /ucircumflex /udieresis /yacute /thorn /ydieresis | |
911 | ] def | |
912 | ")) | |
913 | ||
914 | (defun ps-mode-heapsort () | |
915 | "Insert function /Heapsort." | |
916 | (interactive) | |
917 | (insert " | |
918 | % `array-element' Heapsort-cvi-or-cvr-or-cvs `number-or-string' | |
919 | /Heapsort-cvi-or-cvr-or-cvs { | |
920 | % 0 get | |
921 | } bind def | |
922 | % `array' Heapsort `sorted-array' | |
923 | /Heapsort { | |
924 | dup length /hsR exch def | |
925 | /hsL hsR 2 idiv 1 add def | |
926 | { | |
927 | hsR 2 lt { exit } if | |
928 | hsL 1 gt { | |
929 | /hsL hsL 1 sub def | |
930 | } { | |
931 | /hsR hsR 1 sub def | |
932 | dup dup dup 0 get exch dup hsR get | |
933 | 0 exch put | |
934 | hsR exch put | |
935 | } ifelse | |
936 | dup hsL 1 sub get /hsT exch def | |
937 | /hsJ hsL def | |
938 | { | |
939 | /hsS hsJ def | |
940 | /hsJ hsJ dup add def | |
941 | hsJ hsR gt { exit } if | |
942 | hsJ hsR lt { | |
943 | dup dup hsJ 1 sub get Heapsort-cvi-or-cvr-or-cvs | |
944 | exch hsJ get Heapsort-cvi-or-cvr-or-cvs | |
945 | lt { /hsJ hsJ 1 add def } if | |
946 | } if | |
947 | dup hsJ 1 sub get Heapsort-cvi-or-cvr-or-cvs | |
948 | hsT Heapsort-cvi-or-cvr-or-cvs | |
949 | le { exit } if | |
950 | dup dup hsS 1 sub exch hsJ 1 sub get put | |
951 | } loop | |
952 | dup hsS 1 sub hsT put | |
953 | } loop | |
954 | } bind def | |
955 | ")) | |
956 | ||
957 | \f | |
958 | ;; EPSF document lay-out. | |
959 | ||
960 | (defun ps-mode-epsf-sparse () | |
961 | "Insert sparse EPSF template." | |
962 | (interactive) | |
963 | (goto-char (point-max)) | |
964 | (unless (re-search-backward "%%EOF[ \t\n]*\\'" nil t) | |
965 | (goto-char (point-max)) | |
966 | (insert "\n%%EOF\n")) | |
967 | (goto-char (point-max)) | |
968 | (unless (re-search-backward "\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t) | |
969 | (re-search-backward "%%EOF") | |
970 | (insert "showpage\n")) | |
971 | (goto-char (point-max)) | |
972 | (unless (re-search-backward "\\bend[ \t\n]+\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t) | |
973 | (re-search-backward "showpage") | |
974 | (insert "\nend\n")) | |
975 | (goto-char (point-min)) | |
976 | (insert "%!PS-Adobe-3.0 EPSF-3.0\n%%BoundingBox: 0 0 ") | |
977 | (insert (format "%d %d\n\n" | |
978 | (car ps-mode-paper-size) | |
979 | (car (cdr ps-mode-paper-size)))) | |
980 | (insert "64 dict begin\n\n")) | |
981 | ||
982 | (defun ps-mode-epsf-rich () | |
983 | "Insert rich EPSF template." | |
984 | (interactive) | |
985 | (ps-mode-epsf-sparse) | |
986 | (forward-line -3) | |
987 | (when buffer-file-name | |
988 | (insert "%%Title: " (file-name-nondirectory buffer-file-name) "\n")) | |
989 | (insert "%%Creator: " (user-full-name) "\n") | |
990 | (insert "%%CreationDate: " (current-time-string) "\n") | |
991 | (insert "%%EndComments\n") | |
992 | (forward-line 3)) | |
993 | ||
994 | \f | |
995 | ;; Interactive PostScript interpreter. | |
996 | ||
997 | (defun ps-run-mode () | |
998 | "Major mode in interactive PostScript window. | |
999 | This mode is invoked from ps-mode and should not be called directly. | |
1000 | ||
1001 | \\{ps-run-mode-map} | |
1002 | " | |
1003 | (kill-all-local-variables) | |
1004 | (make-local-variable 'font-lock-defaults) | |
c22d928f GM |
1005 | (setq font-lock-defaults '((ps-run-font-lock-keywords |
1006 | ps-run-font-lock-keywords-1 | |
1007 | ps-run-font-lock-keywords-2) | |
1008 | t) | |
99485bca GM |
1009 | major-mode 'ps-run-mode |
1010 | mode-name "Interactive PS" | |
1011 | mode-line-process '(":%s")) | |
1012 | (use-local-map ps-run-mode-map) | |
1013 | (run-hooks 'ps-run-mode-hook)) | |
1014 | ||
1015 | (defun ps-run-running () | |
1016 | "Error if not in ps-mode or not running PostScript." | |
1017 | (unless (equal major-mode 'ps-mode) | |
1018 | (error "This function can only be called from PostScript mode")) | |
1019 | (unless (equal (process-status "ps-run") 'run) | |
1020 | (error "No PostScript process running"))) | |
1021 | ||
1022 | (defun ps-run-start () | |
1023 | "Start interactive PostScript." | |
1024 | (interactive) | |
1025 | (let ((command (if (and window-system ps-run-x) ps-run-x ps-run-dumb)) | |
1026 | (init-file nil) | |
1027 | (process-connection-type nil) | |
99485bca GM |
1028 | (oldwin (selected-window)) |
1029 | i) | |
1030 | (unless command | |
1031 | (error "No command specified to run interactive PostScript")) | |
1032 | (unless (and ps-run-mark (markerp ps-run-mark)) | |
1033 | (setq ps-run-mark (make-marker))) | |
1034 | (when ps-run-init | |
1035 | (setq init-file (ps-run-make-tmp-filename)) | |
c22d928f | 1036 | (write-region (concat ps-run-init "\n") 0 init-file) |
99485bca GM |
1037 | (setq init-file (list init-file))) |
1038 | (pop-to-buffer "*ps run*") | |
1039 | (ps-run-mode) | |
1040 | (when (process-status "ps-run") | |
1041 | (delete-process "ps-run")) | |
1042 | (erase-buffer) | |
1043 | (setq i (append command init-file)) | |
1044 | (while i | |
1045 | (insert (car i) (if (cdr i) " " "\n")) | |
1046 | (setq i (cdr i))) | |
1047 | (eval (append '(start-process "ps-run" "*ps run*") command init-file)) | |
1048 | (select-window oldwin))) | |
1049 | ||
1050 | (defun ps-run-quit () | |
1051 | "Quit interactive PostScript." | |
1052 | (interactive) | |
1053 | (ps-run-send-string "quit" t) | |
1054 | (ps-run-cleanup)) | |
1055 | ||
1056 | (defun ps-run-kill () | |
1057 | "Kill interactive PostScript." | |
1058 | (interactive) | |
1059 | (delete-process "ps-run") | |
1060 | (ps-run-cleanup)) | |
1061 | ||
1062 | (defun ps-run-clear () | |
1063 | "Clear/reset PostScript graphics." | |
1064 | (interactive) | |
1065 | (ps-run-send-string "showpage" t) | |
1066 | (sit-for 1) | |
1067 | (ps-run-send-string "" t)) | |
1068 | ||
1069 | (defun ps-run-buffer () | |
1070 | "Send buffer to PostScript interpreter." | |
1071 | (interactive) | |
1072 | (ps-run-region (point-min) (point-max))) | |
1073 | ||
1074 | (defun ps-run-region (begin end) | |
1075 | "Send region to PostScript interpreter." | |
1076 | (interactive "r") | |
1077 | (ps-run-running) | |
1078 | (setq ps-run-parent (buffer-name)) | |
1079 | (let ((f (ps-run-make-tmp-filename))) | |
1080 | (set-marker ps-run-mark begin) | |
1081 | (write-region begin end f) | |
1082 | (ps-run-send-string (format "(%s) run" f) t))) | |
1083 | ||
1084 | (defun ps-run-boundingbox () | |
1085 | "View BoundingBox" | |
1086 | (interactive) | |
1087 | (ps-run-running) | |
1088 | (let (x1 y1 x2 y2 f | |
1089 | (buf (current-buffer))) | |
1090 | (save-excursion | |
1091 | (goto-char 1) | |
1092 | (re-search-forward | |
1093 | "^%%BoundingBox:[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)") | |
1094 | (setq x1 (match-string 1) | |
1095 | y1 (match-string 2) | |
1096 | x2 (match-string 3) | |
1097 | y2 (match-string 4))) | |
1098 | (unless (< (string-to-number x1) (string-to-number x2)) | |
1099 | (error "x1 (%s) should be less than x2 (%s)" x1 x2)) | |
1100 | (unless (< (string-to-number y1) (string-to-number y2)) | |
1101 | (error "y1 (%s) should be less than y2 (%s)" y1 y2)) | |
1102 | (setq f (ps-run-make-tmp-filename)) | |
1103 | (write-region | |
1104 | (format | |
1105 | "gsave | |
1106 | initgraphics | |
1107 | 2 setlinewidth | |
1108 | %s %s moveto | |
1109 | %s %s lineto | |
1110 | %s %s lineto | |
1111 | %s %s lineto | |
1112 | closepath | |
1113 | gsave | |
1114 | [ 4 20 ] 0 setdash | |
1115 | 1 0 0 setrgbcolor | |
1116 | stroke | |
1117 | grestore | |
1118 | gsave | |
1119 | [ 4 20 ] 8 setdash | |
1120 | 0 1 0 setrgbcolor | |
1121 | stroke | |
1122 | grestore | |
1123 | [ 4 20 ] 16 setdash | |
1124 | 0 0 1 setrgbcolor | |
1125 | stroke | |
1126 | grestore | |
1127 | " x1 y1 x2 y1 x2 y2 x1 y2) | |
1128 | 0 | |
1129 | f) | |
1130 | (ps-run-send-string (format "(%s) run" f) t) | |
1131 | (set-buffer buf))) | |
1132 | ||
1133 | (defun ps-run-send-string (string &optional echo) | |
1134 | (let ((oldwin (selected-window))) | |
1135 | (pop-to-buffer "*ps run*") | |
1136 | (goto-char (point-max)) | |
1137 | (when echo | |
1138 | (insert string "\n")) | |
1139 | (set-marker (process-mark (get-process "ps-run")) (point)) | |
1140 | (process-send-string "ps-run" (concat string "\n")) | |
1141 | (select-window oldwin))) | |
1142 | ||
1143 | (defun ps-run-make-tmp-filename () | |
1144 | (unless ps-mode-tmp-file | |
1145 | (cond (ps-run-tmp-dir) | |
1146 | ((setq ps-run-tmp-dir (getenv "TEMP"))) | |
1147 | ((setq ps-run-tmp-dir (getenv "TMP"))) | |
1148 | ((setq ps-run-tmp-dir (getenv "HOME")) | |
1149 | (setq | |
1150 | ps-run-tmp-dir | |
1151 | (concat (file-name-as-directory ps-run-tmp-dir) "tmp")) | |
1152 | (unless (file-directory-p ps-run-tmp-dir) | |
1153 | (setq ps-run-tmp-dir nil)))) | |
1154 | (unless ps-run-tmp-dir | |
1155 | (setq ps-run-tmp-dir "/tmp")) | |
1156 | (setq ps-mode-tmp-file | |
1157 | (make-temp-name | |
1158 | (concat | |
1159 | (if ps-run-tmp-dir | |
1160 | (file-name-as-directory ps-run-tmp-dir) | |
1161 | "") | |
1162 | "ps-run-")))) | |
1163 | ps-mode-tmp-file) | |
1164 | ||
1165 | ;; Remove temporary file | |
1166 | ;; This shouldn't fail twice, because it is called at kill-emacs | |
1167 | (defun ps-run-cleanup () | |
1168 | (when ps-mode-tmp-file | |
1169 | (let ((i ps-mode-tmp-file)) | |
1170 | (setq ps-mode-tmp-file nil) | |
1171 | (when (file-exists-p i) | |
1172 | (delete-file i))))) | |
1173 | ||
1174 | (defun ps-run-mouse-goto-error (event) | |
1175 | "Set point at mouse click, then call ps-run-goto-error." | |
1176 | (interactive "e") | |
1177 | (mouse-set-point event) | |
1178 | (ps-run-goto-error)) | |
1179 | ||
1180 | (defun ps-run-newline () | |
1181 | "Process newline in PostScript interpreter window." | |
1182 | (interactive) | |
1183 | (end-of-line) | |
1184 | (insert "\n") | |
1185 | (forward-line -1) | |
c22d928f | 1186 | (when (looking-at ps-run-prompt) |
99485bca GM |
1187 | (goto-char (match-end 0))) |
1188 | (looking-at ".*") | |
1189 | (goto-char (1+ (match-end 0))) | |
1190 | (ps-run-send-string (buffer-substring (match-beginning 0) (match-end 0)))) | |
1191 | ||
1192 | (defun ps-run-goto-error () | |
1193 | "Jump to buffer position read as integer at point. | |
1194 | Use line numbers if ps-run-error-line-numbers is not nil" | |
1195 | (interactive) | |
1196 | (let ((p (point))) | |
1197 | (unless (looking-at "[0-9]") | |
1198 | (goto-char (max 1 (1- (point))))) | |
1199 | (when (looking-at "[0-9]") | |
1200 | (forward-char 1) | |
1201 | (forward-word -1) | |
1202 | (when (looking-at "[0-9]+") | |
1203 | (let (i) | |
1204 | (setq | |
1205 | i | |
1206 | (string-to-int | |
1207 | (buffer-substring (match-beginning 0) (match-end 0)))) | |
1208 | (goto-char p) | |
1209 | (pop-to-buffer ps-run-parent) | |
1210 | (if ps-run-error-line-numbers | |
1211 | (progn | |
1212 | (goto-char (marker-position ps-run-mark)) | |
1213 | (forward-line (1- i)) | |
1214 | (end-of-line)) | |
1215 | (goto-char (+ i (marker-position ps-run-mark))))))))) | |
1216 | ||
1217 | \f | |
1218 | ;; | |
1219 | (add-hook 'kill-emacs-hook 'ps-run-cleanup) | |
1220 | ||
1221 | (provide 'ps-mode) | |
1222 | ||
1223 | ;;; ps-mode.el ends here |