|
0
|
1 ;;; postscript.el --- major mode for editing PostScript programs
|
|
|
2
|
|
|
3 ;; Keywords: langauges
|
|
|
4
|
|
|
5 ;; This file is part of XEmacs.
|
|
|
6
|
|
|
7 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
8 ;; under the terms of the GNU General Public License as published by
|
|
|
9 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
10 ;; any later version.
|
|
|
11
|
|
|
12 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
15 ;; General Public License for more details.
|
|
|
16
|
|
|
17 ;; You should have received a copy of the GNU General Public License
|
|
16
|
18 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
20 ;; Boston, MA 02111-1307, USA.
|
|
0
|
21
|
|
|
22 ;;; Synched up with: Not in FSF.
|
|
|
23
|
|
|
24 ;;
|
|
|
25 ;; Author: Chris Maio
|
|
|
26 ;; Last edit: 4 Sep 1988
|
|
|
27 ;; Includes patches from relph@presto.ig.com (John M. Relph) posted to
|
|
|
28 ;; gnu.emacs.sources on 22 Nov 90 04:53:43 GMT.
|
|
|
29 ;;
|
|
|
30 ;; The following two statements, placed in your .emacs file or site-init.el,
|
|
|
31 ;; will cause this file to be autoloaded, and postscript-mode invoked, when
|
|
|
32 ;; visiting .ps or .cps files:
|
|
|
33 ;;
|
|
|
34 ;; (autoload 'postscript-mode "postscript.el" "" t)
|
|
|
35 ;; (setq auto-mode-alist
|
|
|
36 ;; (cons '("\\.c?ps$".postscript-mode) auto-mode-alist))
|
|
|
37 ;;
|
|
|
38
|
|
|
39 (provide 'postscript)
|
|
|
40
|
|
|
41 (defconst ps-indent-level 2
|
|
|
42 "*Indentation to be used inside of PostScript blocks or arrays")
|
|
|
43
|
|
|
44 (defconst ps-tab-width 8
|
|
|
45 "*Tab stop width for PostScript mode")
|
|
|
46
|
|
|
47 (defun ps-make-tabs (stop)
|
|
|
48 (and (< stop 132) (cons stop (ps-make-tabs (+ stop ps-tab-width)))))
|
|
|
49
|
|
|
50 (defconst ps-tab-stop-list (ps-make-tabs ps-tab-width)
|
|
|
51 "*Tab stop list for PostScript mode")
|
|
|
52
|
|
|
53 (defconst ps-postscript-command '("gs" "-")
|
|
|
54 "*Command used to invoke with a printer spooler or NeWS server.")
|
|
|
55
|
|
|
56 (defvar ps-mode-map nil
|
|
|
57 "Keymap used in PostScript mode buffers")
|
|
|
58
|
|
|
59 (defvar ps-mode-syntax-table nil
|
|
|
60 "PostScript mode syntax table")
|
|
|
61
|
|
|
62 (defvar ps-balanced-string-syntax-p
|
|
|
63 (let ((b (current-buffer))
|
|
|
64 (loser (generate-new-buffer "x")))
|
|
|
65 (unwind-protect
|
|
|
66 (progn
|
|
|
67 (set-buffer loser)
|
|
|
68 (set-syntax-table (copy-syntax-table))
|
|
|
69 (modify-syntax-entry ?\( "\"\)")
|
|
|
70 (insert "((")
|
|
|
71 (let ((v (parse-partial-sexp (point-min) (point-max))))
|
|
|
72 (if (elt v 3)
|
|
|
73 ;; New syntax code think's we're still inside a string
|
|
|
74 t
|
|
|
75 nil)))
|
|
|
76 (set-buffer b)
|
|
|
77 (kill-buffer loser))))
|
|
|
78
|
|
|
79 (defconst postscript-font-lock-keywords (purecopy
|
|
|
80 (list
|
|
|
81 ;; Proper rule for Postscript strings
|
|
|
82 '("(\\([^)]\\|\\\\.\\|\\\\\n\\)*)" . font-lock-string-face)
|
|
|
83 ;; Make any line beginning with a / be a ``keyword''
|
|
|
84 '("^/[^\n%]*" . font-lock-keyword-face)
|
|
|
85 ;; Make brackets of all forms be keywords
|
|
|
86 '("[][<>{}]+" . font-lock-keyword-face)
|
|
|
87 ;; Keywords
|
|
|
88 (list (concat
|
|
|
89 "[][ \t\f\n\r()<>{}/%]" ;delimiter
|
|
|
90 "\\("
|
|
|
91 (mapconcat 'identity
|
|
|
92 '("begin" "end"
|
|
|
93 "save" "restore" "gsave" "grestore"
|
|
|
94 ;; Any delimited name ending in 'def'
|
|
|
95 "[a-zA-Z0-9-._]*def"
|
|
|
96 "[Dd]efine[a-zA-Z0-9-._]*")
|
|
|
97 "\\|")
|
|
|
98 "\\)"
|
|
|
99 "\\([][ \t\f\n\r()<>{}/%]\\|$\\)" ;delimiter
|
|
|
100 )
|
|
|
101 1 'font-lock-keyword-face)))
|
|
|
102 "Expressions to highlight in Postscript buffers.")
|
|
|
103 (put 'postscript-mode 'font-lock-defaults '(postscript-font-lock-keywords))
|
|
|
104
|
|
|
105 (if ps-mode-syntax-table
|
|
|
106 nil
|
|
|
107 (let ((i 0))
|
|
|
108 (setq ps-mode-syntax-table (copy-syntax-table nil))
|
|
|
109 (while (< i 256)
|
|
|
110 (or (= (char-syntax i ps-mode-syntax-table) ?w)
|
|
|
111 (modify-syntax-entry i "_" ps-mode-syntax-table))
|
|
|
112 (setq i (1+ i)))
|
|
|
113 (modify-syntax-entry ?\ " " ps-mode-syntax-table)
|
|
|
114 (modify-syntax-entry ?\t " " ps-mode-syntax-table)
|
|
|
115 (modify-syntax-entry ?\f " " ps-mode-syntax-table)
|
|
|
116 (modify-syntax-entry ?\r " " ps-mode-syntax-table)
|
|
|
117 (modify-syntax-entry ?\% "<" ps-mode-syntax-table)
|
|
|
118 (modify-syntax-entry ?\n ">" ps-mode-syntax-table)
|
|
|
119 (modify-syntax-entry ?\\ "\\" ps-mode-syntax-table)
|
|
|
120 (modify-syntax-entry ?? "_" ps-mode-syntax-table)
|
|
|
121 (modify-syntax-entry ?_ "_" ps-mode-syntax-table)
|
|
|
122 (modify-syntax-entry ?. "_" ps-mode-syntax-table)
|
|
|
123 (modify-syntax-entry ?/ "'" ps-mode-syntax-table)
|
|
|
124 (if ps-balanced-string-syntax-p
|
|
|
125 (progn
|
|
|
126 (modify-syntax-entry ?\( "\"\)" ps-mode-syntax-table)
|
|
|
127 (modify-syntax-entry ?\) "\"\(" ps-mode-syntax-table))
|
|
|
128 (progn
|
|
|
129 ;; This isn't correct, but Emacs syntax stuff
|
|
|
130 ;; has no way to deal with string syntax which uses
|
|
|
131 ;; different open and close characters. Sigh.
|
|
|
132 (modify-syntax-entry ?\( "(" ps-mode-syntax-table)
|
|
|
133 (modify-syntax-entry ?\) ")" ps-mode-syntax-table)))
|
|
|
134 (modify-syntax-entry ?\[ "(\]" ps-mode-syntax-table)
|
|
|
135 (modify-syntax-entry ?\] ")\[" ps-mode-syntax-table)
|
|
|
136 (modify-syntax-entry ?\{ "\(\}" ps-mode-syntax-table)
|
|
|
137 (modify-syntax-entry ?\} "\)\}" ps-mode-syntax-table)
|
|
|
138 (modify-syntax-entry ?/ "' p" ps-mode-syntax-table)
|
|
|
139 ))
|
|
|
140
|
|
|
141
|
|
|
142 ;;;###autoload
|
|
|
143 (defun postscript-mode ()
|
|
|
144 "Major mode for editing PostScript files.
|
|
|
145
|
|
|
146 \\[ps-execute-buffer] will send the contents of the buffer to the NeWS
|
|
|
147 server using psh(1). \\[ps-execute-region] sends the current region.
|
|
|
148 \\[ps-shell] starts an interactive psh(1) window which will be used for
|
|
|
149 subsequent \\[ps-execute-buffer] or \\[ps-execute-region] commands.
|
|
|
150
|
|
|
151 In this mode, TAB and \\[indent-region] attempt to indent code
|
|
|
152 based on the position of {}, [], and begin/end pairs. The variable
|
|
|
153 ps-indent-level controls the amount of indentation used inside
|
|
|
154 arrays and begin/end pairs.
|
|
|
155
|
|
|
156 \\{ps-mode-map}
|
|
|
157
|
|
|
158 \\[postscript-mode] calls the value of the variable postscript-mode-hook
|
|
|
159 with no args, if that value is non-nil."
|
|
|
160 (interactive)
|
|
|
161 (kill-all-local-variables)
|
|
|
162 (use-local-map ps-mode-map)
|
|
|
163 (set-syntax-table ps-mode-syntax-table)
|
|
|
164 (make-local-variable 'comment-start)
|
|
|
165 (setq comment-start "% ")
|
|
|
166 (make-local-variable 'comment-start-skip)
|
|
|
167 (setq comment-start-skip "%+ *")
|
|
|
168 (make-local-variable 'comment-column)
|
|
|
169 (setq comment-column 40)
|
|
|
170 (make-local-variable 'indent-line-function)
|
|
|
171 (setq indent-line-function 'ps-indent-line)
|
|
|
172 (make-local-variable 'tab-stop-list)
|
|
|
173 (setq tab-stop-list ps-tab-stop-list)
|
|
|
174 (make-local-variable 'page-delimiter)
|
|
|
175 (setq page-delimiter "^showpage")
|
|
|
176 (make-local-variable 'parse-sexp-ignore-comments)
|
|
|
177 (setq parse-sexp-ignore-comments t)
|
|
|
178 (setq mode-name "PostScript")
|
|
|
179 (setq major-mode 'postscript-mode)
|
|
|
180 (run-hooks 'ps-mode-hook) ; bad name! Kept for compatibility.
|
|
|
181 (run-hooks 'postscript-mode-hook)
|
|
|
182 )
|
|
|
183
|
|
|
184 (defun ps-tab ()
|
|
|
185 "Command assigned to the TAB key in PostScript mode."
|
|
|
186 (interactive)
|
|
|
187 (if (save-excursion (skip-chars-backward " \t") (bolp))
|
|
|
188 (ps-indent-line)
|
|
|
189 (save-excursion
|
|
|
190 (ps-indent-line))))
|
|
|
191
|
|
|
192 (defun ps-indent-line ()
|
|
|
193 "Indents a line of PostScript code."
|
|
|
194 (interactive)
|
|
|
195 (beginning-of-line)
|
|
|
196 (delete-horizontal-space)
|
|
|
197 (if (not (or (looking-at "%%") ; "%%" comments stay at left margin
|
|
|
198 (ps-top-level-p)))
|
|
|
199 (if (and (< (point) (point-max))
|
|
|
200 (eq ?\) (char-syntax (char-after (point)))))
|
|
|
201 (ps-indent-close) ; indent close-delimiter
|
|
|
202 (if (looking-at "\\(dict\\|class\\)?end\\|cdef\\|grestore\\|>>")
|
|
|
203 (ps-indent-end) ; indent end token
|
|
|
204 (ps-indent-in-block))))) ; indent line after open delimiter
|
|
|
205
|
|
|
206 ;(defun ps-open ()
|
|
|
207 ; (interactive)
|
|
|
208 ; (insert last-command-char))
|
|
|
209
|
|
|
210 (defun ps-insert-d-char (arg)
|
|
|
211 "Awful hack to make \"end\" and \"cdef\" keywords indent themselves."
|
|
|
212 (interactive "p")
|
|
|
213 (insert-char last-command-char arg)
|
|
|
214 (save-excursion
|
|
|
215 (beginning-of-line)
|
|
|
216 (if (looking-at "^[ \t]*\\(\\(dict\\|class\\)?end\\|cdef\\|grestore\\)")
|
|
|
217 (progn
|
|
|
218 (delete-horizontal-space)
|
|
|
219 (ps-indent-end)))))
|
|
|
220
|
|
|
221 (defun ps-close ()
|
|
|
222 "Inserts and indents a close delimiter."
|
|
|
223 (interactive)
|
|
|
224 (insert last-command-char)
|
|
|
225 (backward-char 1)
|
|
|
226 (ps-indent-close)
|
|
|
227 (forward-char 1)
|
|
|
228 (blink-matching-open))
|
|
|
229
|
|
|
230 (defun ps-indent-close ()
|
|
|
231 "Internal function to indent a line containing a an array close delimiter."
|
|
|
232 (if (save-excursion (skip-chars-backward " \t") (bolp))
|
|
|
233 (let (x (oldpoint (point)))
|
|
|
234 (forward-char) (backward-sexp) ;XXX
|
|
|
235 (if (and (eq 1 (count-lines (point) oldpoint))
|
|
|
236 (> 1 (- oldpoint (point))))
|
|
|
237 (goto-char oldpoint)
|
|
|
238 (beginning-of-line)
|
|
|
239 (skip-chars-forward " \t")
|
|
|
240 (setq x (current-column))
|
|
|
241 (goto-char oldpoint)
|
|
|
242 (delete-horizontal-space)
|
|
|
243 (indent-to x)))))
|
|
|
244
|
|
|
245 (defun ps-indent-end ()
|
|
|
246 "Indent an \"end\" token or array close delimiter."
|
|
|
247 (let ((goal (ps-block-start)))
|
|
|
248 (if (not goal)
|
|
|
249 (indent-relative)
|
|
|
250 (setq goal (save-excursion
|
|
|
251 (goto-char goal) (back-to-indentation) (current-column)))
|
|
|
252 (indent-to goal))))
|
|
|
253
|
|
|
254 (defun ps-indent-in-block ()
|
|
|
255 "Indent a line which does not open or close a block."
|
|
|
256 (let ((goal (ps-block-start)))
|
|
|
257 (setq goal (save-excursion
|
|
|
258 (goto-char goal)
|
|
|
259 (back-to-indentation)
|
|
|
260 (if (bolp)
|
|
|
261 ps-indent-level
|
|
|
262 (back-to-indentation)
|
|
|
263 (+ (current-column) ps-indent-level))))
|
|
|
264 (indent-to goal)))
|
|
|
265
|
|
|
266 ;;; returns nil if at top-level, or char pos of beginning of current block
|
|
|
267 (defun ps-block-start ()
|
|
|
268 "Returns the character position of the character following the nearest
|
|
|
269 enclosing `[' `{' or `begin' keyword."
|
|
|
270 (save-excursion
|
|
|
271 (let ((open (condition-case nil
|
|
|
272 (save-excursion
|
|
|
273 (backward-up-list 1)
|
|
|
274 (1+ (point)))
|
|
|
275 (error nil))))
|
|
|
276 (ps-begin-end-hack open))))
|
|
|
277
|
|
|
278 (defun ps-begin-end-hack (start)
|
|
|
279 "Search backwards from point to START for enclosing `begin' and returns the
|
|
|
280 character number of the character following `begin' or START if not found."
|
|
|
281 (save-excursion
|
|
|
282 (let ((depth 1))
|
|
|
283 (while (and (> depth 0)
|
|
|
284 (or (re-search-backward "^[ \t]*\\(dict\\|class\\)?\\(end\\|grestore\\|>>\\)\\|\\(begin\\|gsave\\|<<\\)[ \t]*\\(%.*\\)*$"
|
|
|
285 start t)
|
|
|
286 (re-search-backward "^[ \t]*cdef.*$" start t)))
|
|
|
287 (setq depth (if (looking-at "[ \t]*\\(dict\\|class\\)?\\(end\\|grestore\\|>>\\)")
|
|
|
288 (1+ depth) (1- depth))))
|
|
|
289 (if (not (eq 0 depth))
|
|
|
290 start
|
|
|
291 (forward-word 1)
|
|
|
292 (point)))))
|
|
|
293
|
|
|
294 (defun ps-top-level-p ()
|
|
|
295 "Awful test to see whether we are inside some sort of PostScript block."
|
|
|
296 (and (condition-case nil
|
|
|
297 (not (scan-lists (point) -1 1))
|
|
|
298 (error t))
|
|
|
299 (not (ps-begin-end-hack nil))))
|
|
|
300
|
|
|
301 ;;; initialize the keymap if it doesn't already exist
|
|
|
302 (if (null ps-mode-map)
|
|
|
303 (progn
|
|
|
304 (setq ps-mode-map (make-sparse-keymap))
|
|
|
305 (set-keymap-name ps-mode-map 'ps-mode-map)
|
|
|
306 ;;(define-key ps-mode-map "d" 'ps-insert-d-char)
|
|
|
307 ;;(define-key ps-mode-map "f" 'ps-insert-d-char)
|
|
|
308 ;;(define-key ps-mode-map "{" 'ps-open)
|
|
|
309 ;;(define-key ps-mode-map "}" 'ps-close)
|
|
|
310 ;;(define-key ps-mode-map "[" 'ps-open)
|
|
|
311 ;;(define-key ps-mode-map "]" 'ps-close)
|
|
|
312 (define-key ps-mode-map "\t" 'ps-tab)
|
|
|
313 (define-key ps-mode-map "\C-c\C-c" 'ps-execute-buffer)
|
|
|
314 (define-key ps-mode-map "\C-c|" 'ps-execute-region)
|
|
|
315 ;; make up yout mind! -- the below or the above?
|
|
|
316 (define-key ps-mode-map "\C-c!" 'ps-shell)
|
|
|
317 ))
|
|
|
318
|
|
|
319 (defun ps-execute-buffer ()
|
|
|
320 "Send the contents of the buffer to a printer or NeWS server."
|
|
|
321 (interactive)
|
|
|
322 (save-excursion
|
|
|
323 (mark-whole-buffer)
|
|
|
324 (ps-execute-region (point-min) (point-max))))
|
|
|
325
|
|
|
326 (defun ps-execute-region (start end)
|
|
|
327 "Send the region between START and END to a printer or NeWS server.
|
|
|
328 You should kill any existing *PostScript* buffer unless you want the
|
|
|
329 PostScript text to be executed in that process."
|
|
|
330 (interactive "r")
|
|
|
331 (let ((start (min (point) (mark)))
|
|
|
332 (end (max (point) (mark))))
|
|
|
333 (condition-case nil
|
|
|
334 (process-send-string "PostScript" (buffer-substring start end))
|
|
|
335 (error (shell-command-on-region
|
|
|
336 start end
|
|
|
337 (mapconcat 'identity ps-postscript-command " ")
|
|
|
338 nil)))))
|
|
|
339
|
|
|
340 (defun ps-shell ()
|
|
|
341 "Start a shell communicating with a PostScript printer or NeWS server."
|
|
|
342 (interactive)
|
|
|
343 (require 'shell)
|
|
|
344 (switch-to-buffer-other-window
|
|
|
345 (apply 'make-comint
|
|
|
346 "PostScript"
|
|
|
347 (car ps-postscript-command)
|
|
|
348 nil
|
|
|
349 (cdr ps-postscript-command)))
|
|
|
350 (make-local-variable 'shell-prompt-pattern)
|
|
|
351 ; (setq shell-prompt-pattern "PS>")
|
|
|
352 (setq shell-prompt-pattern "GS>")
|
|
|
353 ; (process-send-string "PostScript" "executive\n")
|
|
|
354 )
|
