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