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