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