Add :link (custom-group-link font-lock-faces) to defgroup.
[emacs.git] / lisp / progmodes / ps-mode.el
blob299093b29bc48f9d4822e40dbf7b35f61965219f
1 ;;; ps-mode.el --- PostScript mode for GNU Emacs
3 ;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005
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, 16 Jun 2005
10 ;; Keywords: PostScript, languages
12 ;; This file is part of GNU Emacs.
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
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
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.
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
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
29 ;;; Commentary:
32 ;;; Code:
34 (defconst ps-mode-version "1.1h, 16 Jun 2005")
35 (defconst ps-mode-maintainer-address "Peter Kleiweg <p.c.j.kleiweg@rug.nl>")
37 (require 'easymenu)
39 ;; Define core `PostScript' group.
40 (defgroup PostScript nil
41 "PostScript mode for Emacs."
42 :group 'languages)
44 (defgroup PostScript-edit nil
45 "PostScript editing."
46 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
47 :prefix "ps-mode-"
48 :group 'PostScript)
50 (defgroup PostScript-interaction nil
51 "PostScript interaction."
52 :prefix "ps-run-"
53 :group 'PostScript)
55 ;; User variables.
57 (defcustom ps-mode-auto-indent t
58 "*Should we use autoindent?"
59 :group 'PostScript-edit
60 :type 'boolean)
62 (defcustom ps-mode-tab 4
63 "*Number of spaces to use when indenting."
64 :group 'PostScript-edit
65 :type 'integer)
67 (defcustom ps-mode-paper-size '(595 842)
68 "*Default paper size.
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))))
109 (defcustom ps-mode-print-function
110 (lambda ()
111 (let ((lpr-switches nil)
112 (lpr-command (if (memq system-type '(usg-unix-v dgux hpux irix))
113 "lp" "lpr")))
114 (lpr-buffer)))
115 "*Lisp function to print current buffer as PostScript."
116 :group 'PostScript-edit
117 :type 'function)
119 (defcustom ps-run-prompt "\\(GS\\(<[0-9]+\\)?>\\)+"
120 "*Regexp to match prompt in interactive PostScript."
121 :group 'PostScript-interaction
122 :type 'regexp)
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))
134 ("^\\(Current file position is\\) \\([0-9]+\\)"
135 (1 font-lock-comment-face nil nil)
136 (2 font-lock-warning-face nil nil))))
137 "*Medium level highlighting of messages from the PostScript interpreter.
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))))))
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))
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))
162 (defcustom ps-run-init nil
163 "*String of commands to send to PostScript to start interactive.
165 Example: \"executive\"
167 You won't need to set this option for Ghostscript."
168 :group 'PostScript-interaction
169 :type '(choice (const nil) string))
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)))
177 (defcustom ps-run-tmp-dir nil
178 "*Name of directory to place temporary file.
180 If nil, the following are tried in turn, until success:
181 1. \"$TEMP\"
182 2. \"$TMP\"
183 3. \"$HOME/tmp\"
184 4. \"/tmp\""
185 :group 'PostScript-interaction
186 :type '(choice (const nil) directory))
189 ;; Constants used for font-lock.
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.")
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.")
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.")
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.")
272 (defconst ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1
273 "Default expressions to highlight in PostScript mode.")
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.")
285 (defconst ps-run-font-lock-keywords ps-run-font-lock-keywords-1
286 "Default expressions to highlight in PostScript run mode.")
289 ;; Variables.
291 (defvar ps-mode-map nil
292 "Local keymap to use in PostScript mode.")
294 (defvar ps-mode-syntax-table nil
295 "Syntax table used while in PostScript mode.")
297 (defvar ps-run-mode-map nil
298 "Local keymap to use in PostScript run mode.")
300 (defvar ps-mode-tmp-file nil
301 "Name of temporary file, set by `ps-run'.")
303 (defvar ps-run-mark nil
304 "Mark to start of region that was sent to PostScript interpreter.")
306 (defvar ps-run-parent nil
307 "Parent window of interactive PostScript.")
310 ;; Menu
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
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
394 ["Print Region as PostScript"
395 ps-mode-print-region
396 (mark t)]
397 "---"
398 ["Customize for PostScript"
399 (customize-group "PostScript")
401 "---"
402 ["Submit Bug Report"
403 ps-mode-submit-bug-report
404 t]))
407 ;; Mode maps for PostScript edit mode and PostScript interaction mode.
409 (unless ps-mode-map
410 (setq ps-mode-map (make-sparse-keymap))
411 (define-key ps-mode-map "\C-cv" 'ps-mode-show-version)
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-c" '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 (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 (define-key ps-run-mode-map "\r" 'ps-run-newline)
440 (define-key ps-run-mode-map [return] 'ps-run-newline))
443 ;; Syntax table.
445 (unless ps-mode-syntax-table
446 (setq ps-mode-syntax-table (make-syntax-table))
448 (modify-syntax-entry ?\% "< " ps-mode-syntax-table)
449 (modify-syntax-entry ?\n "> " ps-mode-syntax-table)
450 (modify-syntax-entry ?\r "> " ps-mode-syntax-table)
451 (modify-syntax-entry ?\f "> " ps-mode-syntax-table)
452 (modify-syntax-entry ?\< "(>" ps-mode-syntax-table)
453 (modify-syntax-entry ?\> ")<" 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)
472 (modify-syntax-entry ?^ "w " ps-mode-syntax-table) ; NOT: ?\^
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)
476 (modify-syntax-entry ?\~ "w " ps-mode-syntax-table)
478 (let ((i 128))
479 (while (< i 256)
480 (modify-syntax-entry i "w " ps-mode-syntax-table)
481 (setq i (1+ i)))))
484 ;; PostScript mode.
486 ;;;###autoload
487 (define-derived-mode ps-mode fundamental-mode "PostScript"
488 "Major mode for editing PostScript with GNU Emacs.
490 Entry to this mode calls `ps-mode-hook'.
492 The following variables hold user options, and can
493 be set through the `customize' command:
495 `ps-mode-auto-indent'
496 `ps-mode-tab'
497 `ps-mode-paper-size'
498 `ps-mode-print-function'
499 `ps-run-prompt'
500 `ps-run-font-lock-keywords-2'
501 `ps-run-x'
502 `ps-run-dumb'
503 `ps-run-init'
504 `ps-run-error-line-numbers'
505 `ps-run-tmp-dir'
507 Type \\[describe-variable] for documentation on these options.
510 \\{ps-mode-map}
513 When starting an interactive PostScript process with \\[ps-run-start],
514 a second window will be displayed, and `ps-run-mode-hook' will be called.
515 The keymap for this second window is:
517 \\{ps-run-mode-map}
520 When Ghostscript encounters an error it displays an error message
521 with a file position. Clicking mouse-2 on this number will bring
522 point to the corresponding spot in the PostScript window, if input
523 to the interpreter was sent from that window.
524 Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect."
525 (set (make-local-variable 'font-lock-defaults)
526 '((ps-mode-font-lock-keywords
527 ps-mode-font-lock-keywords-1
528 ps-mode-font-lock-keywords-2
529 ps-mode-font-lock-keywords-3)
531 (set (make-local-variable 'comment-start) "%")
532 ;; NOTE: `\' has a special meaning in strings only
533 (set (make-local-variable 'comment-start-skip) "%+[ \t]*"))
535 (defun ps-mode-show-version ()
536 "Show current version of PostScript mode."
537 (interactive)
538 (message " *** PostScript Mode (ps-mode) Version %s *** " ps-mode-version))
540 (defun ps-mode-submit-bug-report ()
541 "Submit via mail a bug report on PostScript mode."
542 (interactive)
543 (when (y-or-n-p "Submit bug report on PostScript mode? ")
544 (let ((reporter-prompt-for-summary-p nil)
545 (reporter-dont-compact-list '(ps-mode-print-function
546 ps-run-font-lock-keywords-2)))
547 (reporter-submit-bug-report
548 ps-mode-maintainer-address
549 (format "ps-mode.el %s [%s]" ps-mode-version system-type)
550 '(ps-mode-auto-indent
551 ps-mode-tab
552 ps-mode-paper-size
553 ps-mode-print-function
554 ps-run-prompt
555 ps-run-font-lock-keywords-2
556 ps-run-x
557 ps-run-dumb
558 ps-run-init
559 ps-run-error-line-numbers
560 ps-run-tmp-dir)))))
563 ;; Helper functions for font-lock.
565 ;; When this function is called, point is at an opening bracket.
566 ;; This function should test if point is at the start of a string
567 ;; with nested brackets.
568 ;; If true: move point to end of string
569 ;; set string to match data nr 2
570 ;; return new point
571 ;; If false: return nil
572 (defun ps-mode-looking-at-nested (limit)
573 (let ((first (point))
574 (level 1)
575 pos)
576 ;; Move past opening bracket.
577 (forward-char 1)
578 (setq pos (point))
579 (while (and (> level 0) (< pos limit))
580 ;; Search next bracket, stepping over escaped brackets.
581 (if (not (looking-at "\\([^()\\\n]\\|\\\\.\\)*\\([()]\\)"))
582 (setq level -1)
583 (setq level (+ level (if (string= "(" (match-string 2)) 1 -1)))
584 (goto-char (setq pos (match-end 0)))))
585 (if (not (= level 0))
587 ;; Found string with nested brackets, now set match data nr 2.
588 (set-match-data (list first pos nil nil first pos))
589 pos)))
591 ;; This function should search for a string or comment
592 ;; If comment, return as match data nr 1
593 ;; If string, return as match data nr 2
594 (defun ps-mode-match-string-or-comment (limit)
595 ;; Find the first potential match.
596 (if (not (re-search-forward "[%(]" limit t))
597 ;; Nothing found: return failure.
599 (let ((end (match-end 0)))
600 (goto-char (match-beginning 0))
601 (cond ((looking-at "\\(%.*\\)\\|\\((\\([^()\\\n]\\|\\\\.\\)*)\\)")
602 ;; It's a comment or string without nested, unescaped brackets.
603 (goto-char (match-end 0))
604 (point))
605 ((ps-mode-looking-at-nested limit)
606 ;; It's a string with nested brackets.
607 (point))
609 ;; Try next match.
610 (goto-char end)
611 (ps-mode-match-string-or-comment limit))))))
614 ;; Key-handlers.
616 (defun ps-mode-target-column ()
617 "To what column should text on current line be indented?
619 Identation is increased if the last token on the current line
620 defines the beginning of a group. These tokens are: { [ <<"
621 (save-excursion
622 (beginning-of-line)
623 (if (looking-at "[ \t]*\\(}\\|\\]\\|>>\\)")
624 (condition-case err
625 (progn
626 (goto-char (match-end 0))
627 (backward-sexp 1)
628 (beginning-of-line)
629 (if (looking-at "[ \t]+")
630 (goto-char (match-end 0)))
631 (current-column))
632 (error
633 (ding)
634 (message "%s" (error-message-string err))
636 (let (target)
637 (if (not (re-search-backward "[^ \t\n\r\f][ \t\n\r\f]*\\=" nil t))
639 (goto-char (match-beginning 0))
640 (beginning-of-line)
641 (if (looking-at "[ \t]+")
642 (goto-char (match-end 0)))
643 (setq target (current-column))
644 (end-of-line)
645 (if (re-search-backward "\\({\\|\\[\\|<<\\)[ \t]*\\(%[^\n]*\\)?\\=" nil t)
646 (setq target (+ target ps-mode-tab)))
647 target)))))
649 (defun ps-mode-newline ()
650 "Insert newline with proper indentation."
651 (interactive)
652 (delete-horizontal-space)
653 (insert "\n")
654 (if ps-mode-auto-indent
655 (indent-to (ps-mode-target-column))))
657 (defun ps-mode-tabkey ()
658 "Indent/reindent current line, or insert tab."
659 (interactive)
660 (let ((column (current-column))
661 target)
662 (if (or (not ps-mode-auto-indent)
663 (< ps-mode-tab 1)
664 (not (re-search-backward "^[ \t]*\\=" nil t)))
665 (insert "\t")
666 (setq target (ps-mode-target-column))
667 (while (<= target column)
668 (setq target (+ target ps-mode-tab)))
669 (indent-line-to target))))
671 (defun ps-mode-backward-delete-char ()
672 "Delete backward indentation, or delete backward character."
673 (interactive)
674 (let ((column (current-column))
675 target)
676 (if (or (not ps-mode-auto-indent)
677 (< ps-mode-tab 1)
678 (not (re-search-backward "^[ \t]+\\=" nil t)))
679 (delete-backward-char 1)
680 (setq target (ps-mode-target-column))
681 (while (> column target)
682 (setq target (+ target ps-mode-tab)))
683 (while (>= target column)
684 (setq target (- target ps-mode-tab)))
685 (if (< target 0)
686 (setq target 0))
687 (indent-line-to target))))
689 (defun ps-mode-r-brace ()
690 "Insert `}' and perform balance."
691 (interactive)
692 (insert "}")
693 (ps-mode-r-balance "}"))
695 (defun ps-mode-r-angle ()
696 "Insert `]' and perform balance."
697 (interactive)
698 (insert "]")
699 (ps-mode-r-balance "]"))
701 (defun ps-mode-r-gt ()
702 "Insert `>' and perform balance."
703 (interactive)
704 (insert ">")
705 (ps-mode-r-balance ">>"))
707 (defun ps-mode-r-balance (right)
708 "Adjust indentification if point after RIGHT."
709 (if ps-mode-auto-indent
710 (save-excursion
711 (when (re-search-backward (concat "^[ \t]*" (regexp-quote right) "\\=") nil t)
712 (indent-line-to (ps-mode-target-column)))))
713 (blink-matching-open))
715 (defun ps-mode-other-newline ()
716 "Perform newline in `*ps run*' buffer."
717 (interactive)
718 (let ((buf (current-buffer)))
719 (set-buffer "*ps run*")
720 (ps-run-newline)
721 (set-buffer buf)))
724 ;; Print PostScript.
726 (defun ps-mode-print-buffer ()
727 "Print buffer as PostScript."
728 (interactive)
729 (funcall ps-mode-print-function))
731 (defun ps-mode-print-region (begin end)
732 "Print region as PostScript, adding minimal header and footer lines:
734 %!PS
735 <region>
736 showpage"
737 (interactive "r")
738 (let ((buf (current-buffer)))
739 (with-temp-buffer
740 (insert "%!PS\n")
741 (insert-buffer-substring buf begin end)
742 (insert "\nshowpage\n")
743 (funcall ps-mode-print-function))))
746 ;; Comment Out / Uncomment.
748 (defun ps-mode-comment-out-region (begin end)
749 "Comment out region."
750 (interactive "r")
751 (let ((endm (make-marker)))
752 (set-marker endm end)
753 (save-excursion
754 (goto-char begin)
755 (if (= (current-column) 0)
756 (insert "%"))
757 (while (and (= (forward-line) 0)
758 (< (point) (marker-position endm)))
759 (insert "%")))
760 (set-marker endm nil)))
762 (defun ps-mode-uncomment-region (begin end)
763 "Uncomment region.
765 Only one `%' is removed, and it has to be in the first column."
766 (interactive "r")
767 (let ((endm (make-marker)))
768 (set-marker endm end)
769 (save-excursion
770 (goto-char begin)
771 (if (looking-at "^%")
772 (delete-char 1))
773 (while (and (= (forward-line) 0)
774 (< (point) (marker-position endm)))
775 (if (looking-at "%")
776 (delete-char 1))))
777 (set-marker endm nil)))
780 ;; Convert 8-bit to octal codes.
782 (defun ps-mode-octal-buffer ()
783 "Change 8-bit characters to octal codes in buffer."
784 (interactive)
785 (ps-mode-octal-region (point-min) (point-max)))
787 (defun ps-mode-octal-region (begin end)
788 "Change 8-bit characters to octal codes in region."
789 (interactive "r")
790 (if buffer-read-only
791 (progn
792 (ding)
793 (message "Buffer is read only"))
794 (save-excursion
795 (let (endm i)
796 (setq endm (make-marker))
797 (set-marker endm end)
798 (goto-char begin)
799 (setq i 0)
800 (while (re-search-forward "[\200-\377]" (marker-position endm) t)
801 (setq i (1+ i))
802 (backward-char)
803 (insert (format "\\%03o" (string-to-char (buffer-substring (point) (1+ (point))))))
804 (delete-char 1))
805 (message "%d change%s made" i (if (= i 1) "" "s"))
806 (set-marker endm nil)))))
809 ;; Cookbook.
811 (defun ps-mode-center ()
812 "Insert function /center."
813 (interactive)
814 (insert "
815 /center {
816 dup stringwidth
817 exch 2 div neg
818 exch 2 div neg
819 rmoveto
820 } bind def
823 (defun ps-mode-right ()
824 "Insert function /right."
825 (interactive)
826 (insert "
827 /right {
828 dup stringwidth
829 exch neg
830 exch neg
831 rmoveto
832 } bind def
835 (defun ps-mode-RE ()
836 "Insert function /RE."
837 (interactive)
838 (insert "
839 % `new-font-name' `encoding-vector' `old-font-name' RE -
840 /RE {
841 findfont
842 dup maxlength dict begin {
843 1 index /FID ne { def } { pop pop } ifelse
844 } forall
845 /Encoding exch def
846 dup /FontName exch def
847 currentdict end definefont pop
848 } bind def
851 (defun ps-mode-latin-extended ()
852 "Insert array /ISOLatin1Extended.
854 This encoding vector contains all the entries from ISOLatin1Encoding
855 plus the usually uncoded characters inserted on positions 1 through 28."
856 (interactive)
857 (insert "
858 % ISOLatin1Encoding, extended with remaining uncoded glyphs
859 /ISOLatin1Extended [
860 /.notdef /Lslash /lslash /OE /oe /Scaron /scaron /Zcaron /zcaron
861 /Ydieresis /trademark /bullet /dagger /daggerdbl /ellipsis /emdash
862 /endash /fi /fl /florin /fraction /guilsinglleft /guilsinglright
863 /perthousand /quotedblbase /quotedblleft /quotedblright
864 /quotesinglbase /quotesingle /.notdef /.notdef /.notdef /space
865 /exclam /quotedbl /numbersign /dollar /percent /ampersand
866 /quoteright /parenleft /parenright /asterisk /plus /comma /minus
867 /period /slash /zero /one /two /three /four /five /six /seven /eight
868 /nine /colon /semicolon /less /equal /greater /question /at /A /B /C
869 /D /E /F /G /H /I /J /K /L /M /N /O /P /Q /R /S /T /U /V /W /X /Y /Z
870 /bracketleft /backslash /bracketright /asciicircum /underscore
871 /quoteleft /a /b /c /d /e /f /g /h /i /j /k /l /m /n /o /p /q /r /s
872 /t /u /v /w /x /y /z /braceleft /bar /braceright /asciitilde
873 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
874 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
875 /.notdef /.notdef /.notdef /dotlessi /grave /acute /circumflex
876 /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla
877 /.notdef /hungarumlaut /ogonek /caron /space /exclamdown /cent
878 /sterling /currency /yen /brokenbar /section /dieresis /copyright
879 /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron
880 /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
881 /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright
882 /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute
883 /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute
884 /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth
885 /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
886 /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn
887 /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring
888 /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave
889 /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute
890 /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute
891 /ucircumflex /udieresis /yacute /thorn /ydieresis
892 ] def
895 (defun ps-mode-heapsort ()
896 "Insert function /Heapsort."
897 (interactive)
898 (insert "
899 % `array-element' Heapsort-cvi-or-cvr-or-cvs `number-or-string'
900 /Heapsort-cvi-or-cvr-or-cvs {
901 % 0 get
902 } bind def
903 % `array' Heapsort `sorted-array'
904 /Heapsort {
905 dup length /hsR exch def
906 /hsL hsR 2 idiv 1 add def
908 hsR 2 lt { exit } if
909 hsL 1 gt {
910 /hsL hsL 1 sub def
912 /hsR hsR 1 sub def
913 dup dup dup 0 get exch dup hsR get
914 0 exch put
915 hsR exch put
916 } ifelse
917 dup hsL 1 sub get /hsT exch def
918 /hsJ hsL def
920 /hsS hsJ def
921 /hsJ hsJ dup add def
922 hsJ hsR gt { exit } if
923 hsJ hsR lt {
924 dup dup hsJ 1 sub get Heapsort-cvi-or-cvr-or-cvs
925 exch hsJ get Heapsort-cvi-or-cvr-or-cvs
926 lt { /hsJ hsJ 1 add def } if
927 } if
928 dup hsJ 1 sub get Heapsort-cvi-or-cvr-or-cvs
929 hsT Heapsort-cvi-or-cvr-or-cvs
930 le { exit } if
931 dup dup hsS 1 sub exch hsJ 1 sub get put
932 } loop
933 dup hsS 1 sub hsT put
934 } loop
935 } bind def
939 ;; EPSF document lay-out.
941 (defun ps-mode-epsf-sparse ()
942 "Insert sparse EPSF template."
943 (interactive)
944 (goto-char (point-max))
945 (unless (re-search-backward "%%EOF[ \t\n]*\\'" nil t)
946 (goto-char (point-max))
947 (insert "\n%%EOF\n"))
948 (goto-char (point-max))
949 (unless (re-search-backward "\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t)
950 (re-search-backward "%%EOF")
951 (insert "showpage\n"))
952 (goto-char (point-max))
953 (unless (re-search-backward "\\bend[ \t\n]+\\bshowpage[ \t\n]+%%EOF[ \t\n]*\\'" nil t)
954 (re-search-backward "showpage")
955 (insert "\nend\n"))
956 (goto-char (point-min))
957 (insert "%!PS-Adobe-3.0 EPSF-3.0\n%%BoundingBox: 0 0 ")
958 (insert (format "%d %d\n\n"
959 (car ps-mode-paper-size)
960 (car (cdr ps-mode-paper-size))))
961 (insert "64 dict begin\n\n"))
963 (defun ps-mode-epsf-rich ()
964 "Insert rich EPSF template."
965 (interactive)
966 (ps-mode-epsf-sparse)
967 (forward-line -3)
968 (when buffer-file-name
969 (insert "%%Title: " (file-name-nondirectory buffer-file-name) "\n"))
970 (insert "%%Creator: " (user-full-name) "\n")
971 (insert "%%CreationDate: " (current-time-string) "\n")
972 (insert "%%EndComments\n")
973 (forward-line 3))
976 ;; Interactive PostScript interpreter.
978 (define-derived-mode ps-run-mode fundamental-mode "Interactive PS"
979 "Major mode in interactive PostScript window.
980 This mode is invoked from `ps-mode' and should not be called directly.
982 \\{ps-run-mode-map}"
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 (equal major-mode '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 'start-process "ps-run" "*ps run*" command)
1020 (select-window oldwin)))
1022 (defun ps-run-quit ()
1023 "Quit interactive PostScript."
1024 (interactive)
1025 (ps-run-send-string "quit" t)
1026 (ps-run-cleanup))
1028 (defun ps-run-kill ()
1029 "Kill interactive PostScript."
1030 (interactive)
1031 (delete-process "ps-run")
1032 (ps-run-cleanup))
1034 (defun ps-run-clear ()
1035 "Clear/reset PostScript graphics."
1036 (interactive)
1037 (ps-run-send-string "showpage" t)
1038 (sit-for 1)
1039 (ps-run-send-string "" t))
1041 (defun ps-run-buffer ()
1042 "Send buffer to PostScript interpreter."
1043 (interactive)
1044 (ps-run-region (point-min) (point-max)))
1046 (defun ps-run-region (begin end)
1047 "Send region to PostScript interpreter."
1048 (interactive "r")
1049 (ps-run-running)
1050 (setq ps-run-parent (buffer-name))
1051 (let ((f (ps-run-make-tmp-filename)))
1052 (set-marker ps-run-mark begin)
1053 (write-region begin end f)
1054 (ps-run-send-string (format "(%s) run" f) t)))
1056 (defun ps-run-boundingbox ()
1057 "View BoundingBox."
1058 (interactive)
1059 (ps-run-running)
1060 (let (x1 y1 x2 y2 f
1061 (buf (current-buffer)))
1062 (save-excursion
1063 (goto-char 1)
1064 (re-search-forward
1065 "^%%BoundingBox:[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)[ \t]+\\(-?[0-9]+\\)")
1066 (setq x1 (match-string 1)
1067 y1 (match-string 2)
1068 x2 (match-string 3)
1069 y2 (match-string 4)))
1070 (unless (< (string-to-number x1) (string-to-number x2))
1071 (error "x1 (%s) should be less than x2 (%s)" x1 x2))
1072 (unless (< (string-to-number y1) (string-to-number y2))
1073 (error "y1 (%s) should be less than y2 (%s)" y1 y2))
1074 (setq f (ps-run-make-tmp-filename))
1075 (write-region
1076 (format
1077 "gsave
1078 initgraphics
1079 2 setlinewidth
1080 %s %s moveto
1081 %s %s lineto
1082 %s %s lineto
1083 %s %s lineto
1084 closepath
1085 gsave
1086 [ 4 20 ] 0 setdash
1087 1 0 0 setrgbcolor
1088 stroke
1089 grestore
1090 gsave
1091 [ 4 20 ] 8 setdash
1092 0 1 0 setrgbcolor
1093 stroke
1094 grestore
1095 [ 4 20 ] 16 setdash
1096 0 0 1 setrgbcolor
1097 stroke
1098 grestore
1099 " x1 y1 x2 y1 x2 y2 x1 y2)
1102 (ps-run-send-string (format "(%s) run" f) t)
1103 (set-buffer buf)))
1105 (defun ps-run-send-string (string &optional echo)
1106 (let ((oldwin (selected-window)))
1107 (pop-to-buffer "*ps run*")
1108 (goto-char (point-max))
1109 (when echo
1110 (insert string "\n"))
1111 (set-marker (process-mark (get-process "ps-run")) (point))
1112 (process-send-string "ps-run" (concat string "\n"))
1113 (select-window oldwin)))
1115 (defun ps-run-make-tmp-filename ()
1116 (unless ps-mode-tmp-file
1117 (cond (ps-run-tmp-dir)
1118 ((setq ps-run-tmp-dir (getenv "TEMP")))
1119 ((setq ps-run-tmp-dir (getenv "TMP")))
1120 ((setq ps-run-tmp-dir (getenv "HOME"))
1121 (setq
1122 ps-run-tmp-dir
1123 (concat (file-name-as-directory ps-run-tmp-dir) "tmp"))
1124 (unless (file-directory-p ps-run-tmp-dir)
1125 (setq ps-run-tmp-dir nil))))
1126 (unless ps-run-tmp-dir
1127 (setq ps-run-tmp-dir "/tmp"))
1128 (setq ps-mode-tmp-file
1129 (make-temp-file
1130 (concat
1131 (if ps-run-tmp-dir
1132 (file-name-as-directory ps-run-tmp-dir)
1134 "ps-run-"))))
1135 ps-mode-tmp-file)
1137 ;; Remove temporary file
1138 ;; This shouldn't fail twice, because it is called at kill-emacs
1139 (defun ps-run-cleanup ()
1140 (when ps-mode-tmp-file
1141 (let ((i ps-mode-tmp-file))
1142 (setq ps-mode-tmp-file nil)
1143 (when (file-exists-p i)
1144 (delete-file i)))))
1146 (defun ps-run-mouse-goto-error (event)
1147 "Set point at mouse click, then call `ps-run-goto-error'."
1148 (interactive "e")
1149 (mouse-set-point event)
1150 (ps-run-goto-error))
1152 (defun ps-run-newline ()
1153 "Process newline in PostScript interpreter window."
1154 (interactive)
1155 (end-of-line)
1156 (insert "\n")
1157 (forward-line -1)
1158 (when (looking-at ps-run-prompt)
1159 (goto-char (match-end 0)))
1160 (looking-at ".*")
1161 (goto-char (1+ (match-end 0)))
1162 (ps-run-send-string (buffer-substring (match-beginning 0) (match-end 0))))
1164 (defun ps-run-goto-error ()
1165 "Jump to buffer position read as integer at point.
1166 Use line numbers if `ps-run-error-line-numbers' is not nil"
1167 (interactive)
1168 (let ((p (point)))
1169 (unless (looking-at "[0-9]")
1170 (goto-char (max 1 (1- (point)))))
1171 (when (looking-at "[0-9]")
1172 (forward-char 1)
1173 (forward-word -1)
1174 (when (looking-at "[0-9]+")
1175 (let (i)
1176 (setq
1178 (string-to-number
1179 (buffer-substring (match-beginning 0) (match-end 0))))
1180 (goto-char p)
1181 (pop-to-buffer ps-run-parent)
1182 (if ps-run-error-line-numbers
1183 (progn
1184 (goto-char (marker-position ps-run-mark))
1185 (forward-line (1- i))
1186 (end-of-line))
1187 (goto-char (+ i (marker-position ps-run-mark)))))))))
1191 (add-hook 'kill-emacs-hook 'ps-run-cleanup)
1193 (provide 'ps-mode)
1195 ;;; arch-tag: dce13d2d-69fb-4ec4-9d5d-6dd29c3f0e6e
1196 ;;; ps-mode.el ends here