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