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