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