Mercurial > hg > xemacs-beta

comparison lisp/modes/postscript.el @ 0:376386a54a3c r19-14

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